From 390ea9543af6afdcd6617cbc2cb24c2daafefd41 Mon Sep 17 00:00:00 2001 From: tipaul Date: Fri, 18 Mar 2005 10:00:54 +0000 Subject: [PATCH] The stats module (ported from head) --- reports/acquisitions_stats.pl | 503 ++++++++++++++++ reports/borrowers_stats.pl | 390 +++++++++++++ reports/borrowers_stats.plugin | 183 ++++++ reports/catalogue_stats.pl | 635 +++++++++++++++++++++ reports/issues_by_borrower_category.plugin | 139 +++-- reports/issues_stats.pl | 532 +++++++++++++++++ reports/manager2.pl | 54 ++ reports/reports-home.pl | 20 + 8 files changed, 2414 insertions(+), 42 deletions(-) create mode 100755 reports/acquisitions_stats.pl create mode 100755 reports/borrowers_stats.pl create mode 100644 reports/borrowers_stats.plugin create mode 100755 reports/catalogue_stats.pl create mode 100755 reports/issues_stats.pl create mode 100755 reports/manager2.pl create mode 100644 reports/reports-home.pl diff --git a/reports/acquisitions_stats.pl b/reports/acquisitions_stats.pl new file mode 100755 index 0000000000..abb8f18221 --- /dev/null +++ b/reports/acquisitions_stats.pl @@ -0,0 +1,503 @@ +#!/usr/bin/perl + +# $Id$ + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use C4::Auth; +use CGI; +use C4::Context; +use HTML::Template; +use C4::Search; +use C4::Output; +use C4::Koha; +use C4::Interface::CGI::Output; +use C4::Circulation::Circ2; + +=head1 NAME + +plugin that shows a stats on borrowers + +=head1 DESCRIPTION + + +=over2 + +=cut + +my $input = new CGI; +my $do_it=$input->param('do_it'); +my $fullreportname = "reports/acquisitions_stats.tmpl"; +my $line = $input->param("Line"); +my $column = $input->param("Column"); +my @filters = $input->param("Filter"); +my $podsp = $input->param("PlacedOnDisplay"); +my $rodsp = $input->param("ReceivedOnDisplay"); +my $calc = $input->param("Cellvalue"); +my $output = $input->param("output"); +my $basename = $input->param("basename"); +my $mime = $input->param("MIME"); +my $del = $input->param("sep"); +#warn "calcul : ".$calc; +my ($template, $borrowernumber, $cookie) + = get_template_and_user({template_name => $fullreportname, + query => $input, + type => "intranet", + authnotrequired => 0, + flagsrequired => {editcatalogue => 1}, + debug => 1, + }); +$template->param(do_it => $do_it); +if ($do_it) { + my $results = calculate($line, $column, $podsp, $rodsp, $calc, \@filters); + if ($output eq "screen"){ + $template->param(mainloop => $results); + output_html_with_http_headers $input, $cookie, $template->output; + exit(1); + } else { + print $input->header(-type => 'application/vnd.sun.xml.calc', + -attachment=>"$basename.csv", + -name=>"$basename.csv" ); + my $cols = @$results[0]->{loopcol}; + my $lines = @$results[0]->{looprow}; + my $sep; + $sep =C4::Context->preference("delimiter"); + print @$results[0]->{line} ."/". @$results[0]->{column} .$sep; + foreach my $col ( @$cols ) { + print $col->{coltitle}.$sep; + } + print "Total\n"; + foreach my $line ( @$lines ) { + my $x = $line->{loopcell}; + print $line->{rowtitle}.$sep; + foreach my $cell (@$x) { + print $cell->{value}.$sep; + } + print $line->{totalrow}; + print "\n"; + } + print "TOTAL"; + $cols = @$results[0]->{loopfooter}; + foreach my $col ( @$cols ) { + print $sep.$col->{totalcol}; + } + print $sep.@$results[0]->{total}; + exit(1); + } +} else { + my $dbh = C4::Context->dbh; + my @values; + my %labels; + my %select; + my $req; + $req = $dbh->prepare("select distinctrow id,name from aqbooksellers order by name"); + $req->execute; + my @select; + push @select,""; +# $select{""}=""; + while (my ($value, $desc) =$req->fetchrow) { + push @select, $desc; +# $select{$value}=$desc; + } + my $CGIBookSellers=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, +# -labels => \%select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare( "select distinctrow bookfundid,bookfundname from aqbookfund order by bookfundname"); + $req->execute; + undef @select; + undef %select; + push @select,""; + $select{""}=""; + while (my ($value,$desc) =$req->fetchrow) { + push @select, $value; + $select{$value}=$desc; + } + my $CGIBudget=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -labels => \%select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare("select distinctrow sort1 from aqorders where sort1 is not null order by sort1"); + $req->execute; + undef @select; + push @select,""; + my $hassort1; + while (my ($value) =$req->fetchrow) { + $hassort1 =1 if ($value); + push @select, $value; + } + my $CGISort1=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare("select distinctrow sort2 from aqorders where sort2 is not null order by sort2"); + $req->execute; + undef @select; + push @select,""; + my $hassort2; + my $hglghtsort2; + while (my ($value) =$req->fetchrow) { + $hassort2 =1 if ($value); + $hglghtsort2= !($hassort1); + push @select, $value; + } + my $CGISort2=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + my @mime = ( C4::Context->preference("MIME") ); + foreach my $mime (@mime){ +# warn "".$mime; + } + + my $CGIextChoice=CGI::scrolling_list( + -name => 'MIME', + -id => 'MIME', + -values => \@mime, + -size => 1, + -multiple => 0 ); + + my @dels = ( C4::Context->preference("delimiter") ); + my $CGIsepChoice=CGI::scrolling_list( + -name => 'sep', + -id => 'sep', + -values => \@dels, + -size => 1, + -multiple => 0 ); + + $template->param( + CGIBookSeller => $CGIBookSellers, + CGIBudget => $CGIBudget, + hassort1=> $hassort1, + hassort2=> $hassort2, + HlghtSort2 => $hglghtsort2, + CGISort1 => $CGISort1, + CGISort2 => $CGISort2, + CGIextChoice => $CGIextChoice, + CGIsepChoice => $CGIsepChoice + ); + +} +output_html_with_http_headers $input, $cookie, $template->output; + + + +sub calculate { + my ($line, $column, $podsp, $rodsp, ,$process, $filters) = @_; + my @mainloop; + my @loopfooter; + my @loopcol; + my @loopline; + my @looprow; + my %globalline; + my $grantotal =0; +# extract parameters + my $dbh = C4::Context->dbh; + +# Filters +# Checking filters +# + my @loopfilter; + for (my $i=0;$i<=7;$i++) { + my %cell; + if ( @$filters[$i] ) { + if ((($i==1) or ($i==3)) and (@$filters[$i-1])) { + $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ; + } + $cell{filter} .= @$filters[$i]; + $cell{crit} .="Placed On From" if ($i==0); + $cell{crit} .="Placed On To" if ($i==1); + $cell{crit} .="Received On From" if ($i==2); + $cell{crit} .="Received On To" if ($i==3); + $cell{crit} .="BookSeller" if ($i==4); + $cell{crit} .="Budget" if ($i==5); + $cell{crit} .="Sort1" if ($i==6); + $cell{crit} .="Sort2" if ($i==7); + push @loopfilter, \%cell; + } + } + + my @linefilter; +# warn "filtres ".@filters[0]; +# warn "filtres ".@filters[1]; +# warn "filtres ".@filters[2]; +# warn "filtres ".@filters[3]; + + $linefilter[0] = @$filters[0] if ($line =~ /closedate/ ) ; + $linefilter[1] = @$filters[1] if ($line =~ /closedate/ ) ; + $linefilter[0] = @$filters[2] if ($line =~ /received/ ) ; + $linefilter[1] = @$filters[3] if ($line =~ /received/ ) ; + $linefilter[0] = @$filters[4] if ($line =~ /bookseller/ ) ; + $linefilter[0] = @$filters[5] if ($line =~ /bookfund/ ) ; + $linefilter[0] = @$filters[6] if ($line =~ /sort1/ ) ; + $linefilter[0] = @$filters[7] if ($line =~ /sort2/ ) ; +#warn "filtre lignes".$linefilter[0]." ".$linefilter[1]; +# + my @colfilter ; + $colfilter[0] = @$filters[0] if ($column =~ /closedate/ ) ; + $colfilter[1] = @$filters[1] if ($column =~ /closedate/ ) ; + $colfilter[0] = @$filters[2] if ($column =~ /received/ ) ; + $colfilter[1] = @$filters[3] if ($column =~ /received/ ) ; + $colfilter[0] = @$filters[4] if ($column =~ /bookseller/ ); + $colfilter[0] = @$filters[5] if ($column =~ /bookfund/ ) ; + $colfilter[0] = @$filters[6] if ($column =~ /sort1/ ) ; + $colfilter[0] = @$filters[7] if ($column =~ /sort2/ ) ; +#warn "filtre col ".$colfilter[0]." ".$colfilter[1]; + +# 1st, loop rows. + my $linefield; + if (($line =~/closedate/) and ($podsp == 1)) { + #Display by day + $linefield .="dayname($line)"; + } elsif (($line=~/closedate/) and ($podsp == 2)) { + #Display by Month + $linefield .="monthname($line)"; + } elsif (($line=~/closedate/) and ($podsp == 3)) { + #Display by Year + $linefield .="Year($line)"; + } elsif (($line =~/received/) and ($rodsp == 1)) { + #Display by day + $linefield .="dayname($line)"; + } elsif (($line=~/received/) and ($rodsp == 2)) { + #Display by Month + $linefield .="monthname($line)"; + } elsif (($line=~/received/) and ($rodsp == 3)) { + #Display by Year + $linefield .="Year($line)"; + } else { + $linefield .= $line; + } + + my $strsth; + $strsth .= "select distinctrow $linefield from aqorders, aqbasket,aqorderbreakdown left join aqorderdelivery on (aqorders.ordernumber =aqorderdelivery.ordernumber ) left join aqbooksellers on (aqbasket.booksellerid=aqbooksellers.id) where (aqorders.basketno=aqbasket.basketno) and (aqorderbreakdown.ordernumber=aqorders.ordernumber) and $line is not null "; + + if ( @linefilter ) { + if ($linefilter[1]){ + if ($linefilter[0]){ + $strsth .= " and $line between ? and ? " ; + } else { + $strsth .= " and $line < ? " ; + } + } elsif (($linefilter[0]) and (($line=~/closedate/) or ($line=~/received/))){ + $strsth .= " and $line > ? " ; + } elsif ($linefilter[0]) { + $linefilter[0] =~ s/\*/%/g; + $strsth .= " and $line LIKE ? " ; + } + } + $strsth .=" group by $linefield"; + $strsth .=" order by $linefield"; + warn "". $strsth; + + my $sth = $dbh->prepare( $strsth ); + if (( @linefilter ) and ($linefilter[1])){ + $sth->execute("'".$linefilter[0]."'","'".$linefilter[1]."'"); + } elsif ($linefilter[0]) { + $sth->execute($linefilter[0]); + } else { + $sth->execute; + } + + while ( my ($celvalue) = $sth->fetchrow) { + my %cell; + if ($celvalue) { + $cell{rowtitle} = $celvalue; +# } else { +# $cell{rowtitle} = ""; + } + $cell{totalrow} = 0; + push @loopline, \%cell; + } + +# 2nd, loop cols. + my $colfield; + if (($column =~/closedate/) and ($podsp == 1)) { + #Display by day + $colfield .="dayname($column)"; + } elsif (($column=~/closedate/) and ($podsp == 2)) { + #Display by Month + $colfield .="monthname($column)"; + } elsif (($column=~/closedate/) and ($podsp == 3)) { + #Display by Year + $colfield .="Year($column)"; + } elsif (($column =~/received/) and ($rodsp == 1)) { + #Display by day + $colfield .="dayname($column)"; + } elsif (($column=~/received/) and ($rodsp == 2)) { + #Display by Month + $colfield .="monthname($column)"; + } elsif (($column=~/received/) and ($rodsp == 3)) { + #Display by Year + $colfield .="Year($column)"; + } else { + $colfield .= $column; + } + + my $strsth2; + $strsth2 .= "select distinctrow $colfield from aqorders, aqbasket,aqorderbreakdown left join aqorderdelivery on (aqorders.ordernumber =aqorderdelivery.ordernumber ) left join aqbooksellers on (aqbasket.booksellerid=aqbooksellers.id) where (aqorders.basketno=aqbasket.basketno) and (aqorderbreakdown.ordernumber=aqorders.ordernumber) and $column is not null "; + + if ( @colfilter ) { + if ($colfilter[1]){ + if ($colfilter[0]){ + $strsth2 .= " and $column between ? and ? " ; + } else { + $strsth2 .= " and $column < ? " ; + } + } elsif (($colfilter[0]) and (($column=~/closedate/) or ($column=~/received/))){ + $strsth2 .= " and $column > ? " ; + } elsif ($colfilter[0]) { + $colfilter[0] =~ s/\*/%/g; + $strsth2 .= " and $column LIKE ? " ; + } + } + $strsth2 .=" group by $colfield"; + $strsth2 .=" order by $colfield"; + warn "". $strsth2; + + my $sth2 = $dbh->prepare( $strsth2 ); + if (( @colfilter ) and ($colfilter[1])){ + warn "from : ".$colfilter[0]." To :".$colfilter[1]; + $sth2->execute("'".$colfilter[0]."'","'".$colfilter[1]."'"); + } elsif ($colfilter[0]) { + $sth2->execute($colfilter[0]); + } else { + $sth2->execute; + } + + while (my ($celvalue) = $sth2->fetchrow) { + my %cell; + if ($celvalue){ +# warn "coltitle :".$celvalue; + $cell{coltitle} = $celvalue; + } + push @loopcol, \%cell; + } +# warn "fin des titres colonnes"; + + my $i=0; + my @totalcol; + my $hilighted=-1; + + #Initialization of cell values..... + my %table; +# warn "init table"; + foreach my $row ( @loopline ) { + foreach my $col ( @loopcol ) { +# warn " init table : $row->{rowtitle} / $col->{coltitle} "; + $table{$row->{rowtitle}}->{$col->{coltitle}}=0; + } + $table{$row->{rowtitle}}->{totalrow}=0; + } + +# preparing calculation + my $strcalc ; + $strcalc .= "SELECT $linefield, $colfield, "; + $strcalc .= "COUNT( aqorders.ordernumber ) " if ($process ==1); + $strcalc .= "SUM( aqorders.quantity * aqorders.listprice ) " if ($process ==2); + $strcalc .= "FROM aqorders, aqbasket,aqorderbreakdown left join aqorderdelivery on (aqorders.ordernumber =aqorderdelivery.ordernumber ) left join aqbooksellers on (aqbasket.booksellerid=aqbooksellers.id) where (aqorders.basketno=aqbasket.basketno) and (aqorderbreakdown.ordernumber=aqorders.ordernumber) "; + + @$filters[0]=~ s/\*/%/g if (@$filters[0]); + $strcalc .= " AND aqbasket.closedate > '" . @$filters[0] ."'" if ( @$filters[0] ); + @$filters[1]=~ s/\*/%/g if (@$filters[1]); + $strcalc .= " AND aqbasket.closedate < '" . @$filters[1] ."'" if ( @$filters[1] ); + @$filters[2]=~ s/\*/%/g if (@$filters[2]); + $strcalc .= " AND aqorderdelivery.deliverydate > '" . @$filters[2] ."'" if ( @$filters[2] ); + @$filters[3]=~ s/\*/%/g if (@$filters[3]); + $strcalc .= " AND aqorderdelivery.deliverydate < '" . @$filters[3] ."'" if ( @$filters[3] ); + @$filters[4]=~ s/\*/%/g if (@$filters[4]); + $strcalc .= " AND aqbooksellers.name like '" . @$filters[4] ."'" if ( @$filters[4] ); + @$filters[5]=~ s/\*/%/g if (@$filters[5]); + $strcalc .= " AND aqbookfund.bookfundid like '" . @$filters[5] ."'" if ( @$filters[5] ); + @$filters[6]=~ s/\*/%/g if (@$filters[6]); + $strcalc .= " AND aqorders.sort1 like '" . @$filters[6] ."'" if ( @$filters[6] ); + @$filters[7]=~ s/\*/%/g if (@$filters[7]); + $strcalc .= " AND aqorders.sort2 like '" . @$filters[7] ."'" if ( @$filters[7] ); + $strcalc .= " group by $linefield, $colfield order by $linefield,$colfield"; + warn "". $strcalc; + my $dbcalc = $dbh->prepare($strcalc); + $dbcalc->execute; + +# warn "filling table"; + my $emptycol; + while (my ($row, $col, $value) = $dbcalc->fetchrow) { +# warn "filling table $row / $col / $value "; + $emptycol = 1 if ($col eq undef); + $col = "zzEMPTY" if ($col eq undef); + $row = "zzEMPTY" if ($row eq undef); + + $table{$row}->{$col}+=$value; + $table{$row}->{totalrow}+=$value; + $grantotal += $value; + } + + push @loopcol,{coltitle => "NULL"} if ($emptycol); + + foreach my $row ( sort keys %table ) { + my @loopcell; + #@loopcol ensures the order for columns is common with column titles + # and the number matches the number of columns + foreach my $col ( @loopcol ) { + my $value =$table{$row}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; + push @loopcell, {value => $value } ; + } + push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row, + 'loopcell' => \@loopcell, + 'hilighted' => ($hilighted >0), + 'totalrow' => $table{$row}->{totalrow} + }; + $hilighted = -$hilighted; + } + +# warn "footer processing"; + foreach my $col ( @loopcol ) { + my $total=0; + foreach my $row ( @looprow ) { + $total += $table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; +# warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle}; + } +# warn "summ for column ".$col->{coltitle}." = ".$total; + push @loopfooter, {'totalcol' => $total}; + } + + + # the header of the table + $globalline{loopfilter}=\@loopfilter; + # the core of the table + $globalline{looprow} = \@looprow; + $globalline{loopcol} = \@loopcol; +# # the foot (totals by borrower type) + $globalline{loopfooter} = \@loopfooter; + $globalline{total}= $grantotal; + $globalline{line} = $line; + $globalline{column} = $column; + push @mainloop,\%globalline; + return \@mainloop; +} + +1; \ No newline at end of file diff --git a/reports/borrowers_stats.pl b/reports/borrowers_stats.pl new file mode 100755 index 0000000000..1d05600ab0 --- /dev/null +++ b/reports/borrowers_stats.pl @@ -0,0 +1,390 @@ +#!/usr/bin/perl + +# $Id$ + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use C4::Auth; +use CGI; +use C4::Context; +use HTML::Template; +use C4::Search; +use C4::Output; +use C4::Koha; +use C4::Interface::CGI::Output; +use C4::Circulation::Circ2; + +=head1 NAME + +plugin that shows a stats on borrowers + +=head1 DESCRIPTION + + +=over2 + +=cut + +my $input = new CGI; +my $do_it=$input->param('do_it'); +my $fullreportname = "reports/borrowers_stats.tmpl"; +my $line = $input->param("Line"); +my $column = $input->param("Column"); +my @filters = $input->param("Filter"); +my $digits = $input->param("digits"); +my $borstat = $input->param("status"); +my $output = $input->param("output"); +my $basename = $input->param("basename"); +my $mime = $input->param("MIME"); +my $del = $input->param("sep"); + +my ($template, $borrowernumber, $cookie) + = get_template_and_user({template_name => $fullreportname, + query => $input, + type => "intranet", + authnotrequired => 0, + flagsrequired => {editcatalogue => 1}, + debug => 1, + }); +$template->param(do_it => $do_it); +if ($do_it) { + my $results = calculate($line, $column, $digits, $borstat, \@filters); + if ($output eq "screen"){ + $template->param(mainloop => $results); + output_html_with_http_headers $input, $cookie, $template->output; + exit(1); + } else { + print $input->header(-type => 'application/vnd.sun.xml.calc', + -name=>"$basename.csv", + -attachment=>"$basename.csv"); + my $cols = @$results[0]->{loopcol}; + my $lines = @$results[0]->{looprow}; + my $sep; + $sep =C4::Context->preference("delimiter"); + print @$results[0]->{line} ."/". @$results[0]->{column} .$sep; + foreach my $col ( @$cols ) { + print $col->{coltitle}.$sep; + } + print "Total\n"; + foreach my $line ( @$lines ) { + my $x = $line->{loopcell}; + print $line->{rowtitle}.$sep; + foreach my $cell (@$x) { + print $cell->{value}.$sep; + } + print $line->{totalrow}; + print "\n"; + } + print "TOTAL"; + $cols = @$results[0]->{loopfooter}; + foreach my $col ( @$cols ) { + print $sep.$col->{totalcol}; + } + print $sep.@$results[0]->{total}; + exit(1); + } +} else { + my $dbh = C4::Context->dbh; + my @values; + my %labels; + my $req; + $req = $dbh->prepare( "select categorycode, description from categories order by description"); + $req->execute; + my %select_catcode; + my @select_catcode; + push @select_catcode,""; + $select_catcode{""} = ""; + while (my ($catcode, $description) =$req->fetchrow) { + push @select_catcode, $catcode; + $select_catcode{$catcode} = $description + } + my $CGICatCode=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select_catcode, + -labels => \%select_catcode, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare( "select distinctrow sort1 from borrowers order by sort1"); + $req->execute; + my @select_sort1; + push @select_sort1,""; + my $hassort1; + while (my ($value) =$req->fetchrow) { + if ($value) { + $hassort1=1; + push @select_sort1, $value; + } + } + my $CGIsort1=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select_sort1, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare( "select distinctrow sort2 from borrowers order by sort2"); + $req->execute; + my @select_sort2; + push @select_sort2,""; + my $hassort2; + while (my ($value) =$req->fetchrow) { + if ($value) { + $hassort2 = 1; + push @select_sort2, $value; + } + } + my $CGIsort2=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select_sort2, + -size => 1, + -multiple => 0 ); + + my @mime = ( C4::Context->preference("MIME") ); + foreach my $mime (@mime){ + warn "".$mime; + } + + my $CGIextChoice=CGI::scrolling_list( + -name => 'MIME', + -id => 'MIME', + -values => \@mime, + -size => 1, + -multiple => 0 ); + + my @dels = ( C4::Context->preference("delimiter") ); + my $CGIsepChoice=CGI::scrolling_list( + -name => 'sep', + -id => 'sep', + -values => \@dels, + -size => 1, + -multiple => 0 ); + $template->param(CGICatcode => $CGICatCode, + CGISort1 => $CGIsort1, + hassort1 => $hassort1, + CGISort2 => $CGIsort2, + hassort2 => $hassort2, + CGIextChoice => $CGIextChoice, + CGIsepChoice => $CGIsepChoice + ); + +} +output_html_with_http_headers $input, $cookie, $template->output; + + + +sub calculate { + my ($line, $column, $digits, $status, $filters) = @_; + my @mainloop; + my @loopfooter; + my @loopcol; + my @loopline; + my @looprow; + my %globalline; + my $grantotal =0; +# extract parameters + my $dbh = C4::Context->dbh; + +# Filters + my $linefilter = ""; +# warn "filtres ".@filters[0]; +# warn "filtres ".@filters[1]; +# warn "filtres ".@filters[2]; +# warn "filtres ".@filters[3]; + + $linefilter = @$filters[0] if ($line =~ /categorycode/ ) ; + $linefilter = @$filters[1] if ($line =~ /zipcode/ ) ; + $linefilter = @$filters[2] if ($line =~ /sort1/ ) ; + $linefilter = @$filters[3] if ($line =~ /sort2/ ) ; +# + my $colfilter = ""; + $colfilter = @$filters[0] if ($column =~ /categorycode/); + $colfilter = @$filters[1] if ($column =~ /zipcode/); + $colfilter = @$filters[2] if ($column =~ /sort1/); + $colfilter = @$filters[3] if ($column =~ /sort2/); + + my @loopfilter; + for (my $i=0;$i<=3;$i++) { + my %cell; + if ( @$filters[$i] ) { + $cell{filter} .= @$filters[$i]; + $cell{crit} .="Cat Code " if ($i==0); + $cell{crit} .="Zip Code" if ($i==1); + $cell{crit} .="Sort1" if ($i==2); + $cell{crit} .="Sort2" if ($i==3); + push @loopfilter, \%cell; + } + } + if ($status) { + push @loopfilter,{crit=>"Status",filter=>$status} + } +# 1st, loop rows. + my $linefield; + if (($line =~/zipcode/) and ($digits)) { + $linefield .="left($line,$digits)"; + } else{ + $linefield .= $line; + } + + my $strsth; + $strsth .= "select distinctrow $linefield from borrowers where $line is not null "; + $linefilter =~ s/\*/%/g; + if ( $linefilter ) { + $strsth .= " and $linefield LIKE ? " ; + } + $strsth .= " and $status='1' " if ($status); + $strsth .=" order by $linefield"; +# warn "". $strsth; + + my $sth = $dbh->prepare( $strsth ); + if ( $linefilter ) { + $sth->execute($linefilter); + } else { + $sth->execute; + } + while ( my ($celvalue) = $sth->fetchrow) { + my %cell; + if ($celvalue) { + $cell{rowtitle} = $celvalue; +# } else { +# $cell{rowtitle} = ""; + } + $cell{totalrow} = 0; + push @loopline, \%cell; + } + +# 2nd, loop cols. + my $colfield; + if (($column =~/zipcode/) and ($digits)) { + $colfield .= "left($column,$digits)"; + } else{ + $colfield .= $column; + } + my $strsth2; + $colfilter =~ s/\*/%/g; + $strsth2 .= "select distinctrow $colfield from borrowers where $column is not null"; + if ( $colfilter ) { + $strsth2 .= " and $colfield LIKE ? "; + } + $strsth2 .= " and $status='1' " if ($status); + $strsth2 .= " order by $colfield"; +# warn "". $strsth2; + my $sth2 = $dbh->prepare( $strsth2 ); + if ($colfilter) { + $sth2->execute($colfilter); + } else { + $sth2->execute; + } + while (my ($celvalue) = $sth2->fetchrow) { + my %cell; + my %ft; + if ($celvalue) { + $cell{coltitle} = $celvalue; + } + push @loopcol, \%cell; + } + + + my $i=0; + my @totalcol; + my $hilighted=-1; + + #Initialization of cell values..... + my %table; +# warn "init table"; + foreach my $row ( @loopline ) { + foreach my $col ( @loopcol ) { +# warn " init table : $row->{rowtitle} / $col->{coltitle} "; + $table{$row->{rowtitle}}->{$col->{coltitle}}=0; + } + $table{$row->{rowtitle}}->{totalrow}=0; + } + +# preparing calculation + my $strcalc .= "SELECT $linefield, $colfield, count( * ) FROM borrowers WHERE 1 "; + @$filters[0]=~ s/\*/%/g if (@$filters[0]); + $strcalc .= " AND categorycode like '" . @$filters[0] ."'" if ( @$filters[0] ); + @$filters[1]=~ s/\*/%/g if (@$filters[1]); + $strcalc .= " AND zipcode like '" . @$filters[1] ."'" if ( @$filters[1] ); + @$filters[2]=~ s/\*/%/g if (@$filters[2]); + $strcalc .= " AND sort1 like '" . @$filters[2] ."'" if ( @$filters[2] ); + @$filters[3]=~ s/\*/%/g if (@$filters[3]); + $strcalc .= " AND sort2 like '" . @$filters[3] ."'" if ( @$filters[3] ); + $strcalc .= " AND $status='1' " if ($status); + $strcalc .= " group by $linefield, $colfield"; +# warn "". $strcalc; + my $dbcalc = $dbh->prepare($strcalc); + $dbcalc->execute; +# warn "filling table"; + + my $emptycol; + while (my ($row, $col, $value) = $dbcalc->fetchrow) { +# warn "filling table $row / $col / $value "; + $emptycol = 1 if ($col eq undef); + $col = "zzEMPTY" if ($col eq undef); + $row = "zzEMPTY" if ($row eq undef); + + $table{$row}->{$col}+=$value; + $table{$row}->{totalrow}+=$value; + $grantotal += $value; + } + + push @loopcol,{coltitle => "NULL"} if ($emptycol); + + foreach my $row ( sort keys %table ) { + my @loopcell; + #@loopcol ensures the order for columns is common with column titles + # and the number matches the number of columns + foreach my $col ( @loopcol ) { + my $value =$table{$row}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; + push @loopcell, {value => $value } ; + } + push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row, + 'loopcell' => \@loopcell, + 'hilighted' => ($hilighted >0), + 'totalrow' => $table{$row}->{totalrow} + }; + $hilighted = -$hilighted; + } + + foreach my $col ( @loopcol ) { + my $total=0; + foreach my $row ( @looprow ) { + $total += $table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; +# warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle}; + } +# warn "summ for column ".$col->{coltitle}." = ".$total; + push @loopfooter, {'totalcol' => $total}; + } + + + # the header of the table + $globalline{loopfilter}=\@loopfilter; + # the core of the table + $globalline{looprow} = \@looprow; + $globalline{loopcol} = \@loopcol; +# # the foot (totals by borrower type) + $globalline{loopfooter} = \@loopfooter; + $globalline{total}= $grantotal; + $globalline{line} = $line; + $globalline{column} = $column; + push @mainloop,\%globalline; + return \@mainloop; +} + +1; \ No newline at end of file diff --git a/reports/borrowers_stats.plugin b/reports/borrowers_stats.plugin new file mode 100644 index 0000000000..3e677afb10 --- /dev/null +++ b/reports/borrowers_stats.plugin @@ -0,0 +1,183 @@ +#!/usr/bin/perl + +# $Id$ + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use C4::Auth; +use CGI; +use C4::Context; +use HTML::Template; +use C4::Search; +use C4::Output; +use C4::Koha; + +=head1 NAME + +plugin that shows a stats on borrowers + +=head1 DESCRIPTION + + +=over2 + +=cut + +sub set_parameters { + my ($template) = @_; + my $dbh = C4::Context->dbh; + return $template; +} + +sub calculate { + my ($line, $column, $filters) = @_; + my @results =(); + my @mainloop; + my @loopfooter; + my @loopcol; + my @looprow; + my %globalline; + my $grantotal =0; +# extract parameters + my $dbh = C4::Context->dbh; +# build the SQL query & execute it + my $linefilter = ""; + $linefilter = @$filters[0] if ($line =~ /categorycode/ ) ; + $linefilter = @$filters[4] if ($line =~ /zipcode/ ) ; + $linefilter = @$filters[2] if ($line =~ /sort1/ ) ; + $linefilter = @$filters[3] if ($line =~ /sort2/ ) ; + + my $colfilter = ""; + $colfilter = @$filters[0] if ($column =~ /categorycode/); + $colfilter = @$filters[4] if ($column =~ /zipcode/); + $colfilter = @$filters[2] if ($column =~ /sort1/); + $colfilter = @$filters[3] if ($column =~ /sort2/); + + my @loopfilter; + for (my $i=0;$i<=4;$i++) { + my %cell; + if ( @$filters[$i] ) { + $cell{filter} .= @$filters[$i]; + $cell{crit} .="Category Code " if ($i==0); + $cell{crit} .="Status" if ($i==1); + $cell{crit} .="Sort1" if ($i==2); + $cell{crit} .="Sort2" if ($i==3); + $cell{crit} .="Zip Code" if ($i==4); + push @loopfilter, \%cell; + } + } +# 1st, loop rows. +#problem with NULL Values. + my $strsth; + $strsth .= "select distinctrow $line from borrowers"; + $linefilter =~ s/\*/%/g; + if ( $linefilter ) { + $strsth .= " where $line LIKE ? and $line is not null" ; + } else { + $strsth .= " where $line is not null" ; + } + $strsth .=" order by $line"; + my $sth = $dbh->prepare( $strsth ); + if ( $linefilter ) { + $sth->execute($linefilter); + } else { + $sth->execute; + } + while ( my ($celvalue) = $sth->fetchrow) { + my %cell; + if ($celvalue) { + $cell{rowtitle} = $celvalue; + } else { + $cell{rowtitle} = ""; + } + $cell{totalrow} = 0; + push @looprow, \%cell; + } + +# 2nd, loop cols. + my $strsth2; + $colfilter =~ s/\*/%/g; + $strsth2 .= "select distinctrow $column from borrowers"; + if ( $colfilter ) { + $strsth2 .= " where $column LIKE ? and $column is not null"; + } else { + $strsth2 .= " where $column is not null"; + } + $strsth2 .= " order by $column"; + my $sth2 = $dbh->prepare( $strsth2 ); + if ($colfilter) { + $sth2->execute($colfilter); + } else { + $sth2->execute; + } + while (my ($celvalue) = $sth2->fetchrow) { + my %cell; + my %ft; + $cell{coltitle} = $celvalue; + $ft{totalcol} = 0; + push @loopcol, \%cell; + push @loopfooter, \%ft; + } +# now, parse each category. Before filling the result array, fill it with 0 to have every itemtype column. + my $strcalc .= "SELECT count( * ) FROM borrowers WHERE $line = ? and $column= ? "; + $strcalc .= " AND categorycode like '" . @$filters[1] ."%' " if ( @$filters[1] ); + $strcalc .= " AND sort1 like ' " . @$filters[2] ."%'" if ( @$filters[2] ); + $strcalc .= " AND sort2 like ' " . @$filters[3] ."%'" if ( @$filters[3] ); + $strcalc .= " AND zipcode like ' " . @$filters[4] ."%'" if ( @$filters[4] ); + my $dbcalc = $dbh->prepare($strcalc); + my $i=0; + my @totalcol; + my $hilighted=-1; + # for each line + for (my $i=0; $i<=$#looprow; $i++) { + my $row = $looprow[$i]->{'rowtitle'}; + my @loopcell; + my $totalrow=0; + # for each column + for (my $j=0;$j<=$#loopcol;$j++) { + my $col = $loopcol[$j]->{'coltitle'}; + $dbcalc->execute($row,$col); + my ($value) = $dbcalc->fetchrow; +# warn "$row / $col / $value"; + $totalrow += $value; + $grantotal += $value; + $loopfooter[$j]->{'totalcol'} +=$value; + push @loopcell,{value => $value}; + } + $looprow[$i]->{'totalrow'}=$totalrow; + $looprow[$i]->{'loopcell'}=\@loopcell; + $looprow[$i]->{'hilighted'} = 1 if $hilighted eq 1; + $hilighted = -$hilighted; + } + +# # the header of the table + $globalline{loopfilter}=\@loopfilter; + $globalline{looprow} = \@looprow; +# # the core of the table + $globalline{loopcol} = \@loopcol; +# # the foot (totals by borrower type) + $globalline{loopfooter} = \@loopfooter; + $globalline{total}= $grantotal; + $globalline{line} = $line; + $globalline{column} = $column; + push @mainloop,\%globalline; + return \@mainloop; +} + +1; \ No newline at end of file diff --git a/reports/catalogue_stats.pl b/reports/catalogue_stats.pl new file mode 100755 index 0000000000..55d6251c92 --- /dev/null +++ b/reports/catalogue_stats.pl @@ -0,0 +1,635 @@ +#!/usr/bin/perl + +# $Id$ + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use C4::Auth; +use CGI; +use C4::Context; +use HTML::Template; +use C4::Search; +use C4::Output; +use C4::Koha; +use C4::Interface::CGI::Output; +use C4::Circulation::Circ2; + +=head1 NAME + +plugin that shows a stats on borrowers + +=head1 DESCRIPTION + + +=over2 + +=cut + +my $input = new CGI; +my $do_it=$input->param('do_it'); +my $fullreportname = "reports/catalogue_stats.tmpl"; +my $line = $input->param("Line"); +my $column = $input->param("Column"); +my @filters = $input->param("Filter"); +my $deweydigits = $input->param("deweydigits"); +my $lccndigits = $input->param("lccndigits"); +my $cotedigits = $input->param("cotedigits"); +my $output = $input->param("output"); +my $basename = $input->param("basename"); +my $mime = $input->param("MIME"); +my $del = $input->param("sep"); + +my ($template, $borrowernumber, $cookie) + = get_template_and_user({template_name => $fullreportname, + query => $input, + type => "intranet", + authnotrequired => 0, + flagsrequired => {editcatalogue => 1}, + debug => 1, + }); +$template->param(do_it => $do_it); +if ($do_it) { + my $results = calculate($line, $column, $deweydigits, $lccndigits, $cotedigits, \@filters); + if ($output eq "screen"){ + $template->param(mainloop => $results); + output_html_with_http_headers $input, $cookie, $template->output; + exit(1); + } else { + print $input->header(-type => 'application/vnd.sun.xml.calc', + -attachment=>"$basename.csv", + -name=>"$basename.csv" ); + my $cols = @$results[0]->{loopcol}; + my $lines = @$results[0]->{looprow}; + my $sep; + $sep =C4::Context->preference("delimiter"); + print @$results[0]->{line} ."/". @$results[0]->{column} .$sep; + foreach my $col ( @$cols ) { + print $col->{coltitle}.$sep; + } + print "Total\n"; + foreach my $line ( @$lines ) { + my $x = $line->{loopcell}; + print $line->{rowtitle}.$sep; + foreach my $cell (@$x) { + print $cell->{value}.$sep; + } + print $line->{totalrow}; + print "\n"; + } + print "TOTAL"; + $cols = @$results[0]->{loopfooter}; + foreach my $col ( @$cols ) { + print $sep.$col->{totalcol}; + } + print $sep.@$results[0]->{total}; + exit(1); + } +} else { + my $dbh = C4::Context->dbh; + my @values; + my %labels; + my $count=0; + my $req; + $req = $dbh->prepare("select distinctrow left(dewey,3) from biblioitems order by dewey"); + $req->execute; + my $hasdewey; + my @select; + push @select,""; + while (my ($value) =$req->fetchrow) { + $hasdewey =1 if (($value) and (! $hasdewey)); + $count++ if (($value) and (! $hasdewey)); + push @select, $value; + } + my $CGIdewey=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare( "select distinctrow left(lccn,3) from biblioitems order by lccn"); + $req->execute; + undef @select; + push @select,""; + my $haslccn; + my $hlghtlccn; + while (my ($value) =$req->fetchrow) { + $hlghtlccn = !($hasdewey); + $haslccn =1 if (($value) and (! $haslccn)); + $count++ if (($value) and (! $haslccn)); + push @select, $value; + } + my $CGIlccn=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare("select distinctrow left(itemcallnumber,5) from items order by itemcallnumber"); + $req->execute; + undef @select; + push @select,""; + my $hascote; + my $hlghtcote; + while (my ($value) =$req->fetchrow) { + $hascote =1 if (($value) and (! $hascote)); + $count++ if (($value) and (! $hascote)); + $hlghtcote = (($hasdewey) and ($haslccn)) or (!($hasdewey) and !($haslccn)); + push @select, $value; + } + my $CGIcote=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + $count++; + my $hglghtDT =$count % 2; +# warn "highlightDT ".$hglghtDT; + $count++; + my $hglghtPub =$count % 2; +# warn "highlightPub ".$hglghtPub; + $count++; + my $hglghtPY =$count % 2; +# warn "highlightPY ".$hglghtPY; + $count++; + my $hglghtHB =$count % 2; +# warn "highlightHB ".$hglghtHB; + $count++; + my $hglghtLOC =$count % 2; +# warn "highlightLOC ".$hglghtLOC; + + + $req = $dbh->prepare("select distinctrow itemtype from biblioitems order by itemtype"); + $req->execute; + undef @select; + push @select,""; + while (my ($value) =$req->fetchrow) { + push @select, $value; + } + my $CGIitemtype=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare("select distinctrow left(publishercode,75) from biblioitems order by publishercode"); + $req->execute; + undef @select; + push @select,""; + while (my ($value) =$req->fetchrow) { + push @select, $value; + } + my $CGIpublisher=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + undef @select; + push @select,""; + my $branches=getbranches(); + my %select_branches; + $select_branches{""} = ""; + foreach my $branch (keys %$branches) { + push @select, $branch; + $select_branches{$branch} = $branches->{$branch}->{'branchname'}; + } + my $CGIbranch=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -labels => \%select_branches, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare("select distinctrow location from items order by location"); + $req->execute; + undef @select; + push @select,""; + my $CGIlocation=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + my @mime = ( C4::Context->preference("MIME") ); + foreach my $mime (@mime){ +# warn "".$mime; + } + + my $CGIextChoice=CGI::scrolling_list( + -name => 'MIME', + -id => 'MIME', + -values => \@mime, + -size => 1, + -multiple => 0 ); + + my @dels = ( C4::Context->preference("delimiter") ); + my $CGIsepChoice=CGI::scrolling_list( + -name => 'sep', + -id => 'sep', + -values => \@dels, + -size => 1, + -multiple => 0 ); + + $template->param(hasdewey=>$hasdewey, + CGIFromDeweyClass => $CGIdewey, + CGIToDeweyClass => $CGIdewey, + haslccn=> $haslccn, + hlghtlccn => $hlghtlccn, + CGIFromLoCClass => $CGIlccn, + CGIToLoCClass => $CGIlccn, + hascote=> $hascote, + hlghtcote => $hlghtcote, + hglghtDT => $hglghtDT, + hglghtPub => $hglghtPub, + hglghtPY => $hglghtPY, + hglghtHB => $hglghtHB, + hglghtLOC => $hglghtLOC, + CGIFromCoteClass => $CGIcote, + CGIToCoteClass => $CGIcote, + CGIItemType => $CGIitemtype, +# CGIFromPublicationYear => $CGIpublicationyear, +# CGIToPublicationYear => $CGIpublicationyear, + CGIPublisher => $CGIpublisher, + CGIBranch => $CGIbranch, + CGILocation => $CGIlocation, + CGIextChoice => $CGIextChoice, + CGIsepChoice => $CGIsepChoice + ); + +} +output_html_with_http_headers $input, $cookie, $template->output; + + + +sub calculate { + my ($line, $column, $deweydigits, $lccndigits, $cotedigits, $filters) = @_; + my @mainloop; + my @loopfooter; + my @loopcol; + my @loopline; + my @looprow; + my %globalline; + my $grantotal =0; +# extract parameters + my $dbh = C4::Context->dbh; + +# Filters +# Checking filters +# + my @loopfilter; + for (my $i=0;$i<=11;$i++) { + my %cell; + if ( @$filters[$i] ) { + if ((($i==1) or ($i==3) or ($i==5) or ($i==9)) and (@$filters[$i-1])) { + $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ; + } + $cell{filter} .= @$filters[$i]; + $cell{crit} .="Dewey Classification From" if ($i==0); + $cell{crit} .="Dewey Classification To" if ($i==1); + $cell{crit} .="Lccn Classification From" if ($i==2); + $cell{crit} .="Lccn Classification To" if ($i==3); + $cell{crit} .="Cote Classification From" if ($i==4); + $cell{crit} .="Cote Classification To" if ($i==5); + $cell{crit} .="Document type" if ($i==6); + $cell{crit} .="Publisher" if ($i==7); + $cell{crit} .="Publication year From" if ($i==8); + $cell{crit} .="Publication year To" if ($i==9); + $cell{crit} .="Branch :" if ($i==10); + $cell{crit} .="Location:" if ($i==11); + push @loopfilter, \%cell; + } + } + + my @linefilter; +# warn "filtres ".@filters[0]; +# warn "filtres ".@filters[1]; +# warn "filtres ".@filters[2]; +# warn "filtres ".@filters[3]; + + $linefilter[0] = @$filters[0] if ($line =~ /dewey/ ) ; + $linefilter[1] = @$filters[1] if ($line =~ /dewey/ ) ; + $linefilter[0] = @$filters[2] if ($line =~ /lccn/ ) ; + $linefilter[1] = @$filters[3] if ($line =~ /lccn/ ) ; + $linefilter[0] = @$filters[4] if ($line =~ /items.itemcallnumber/ ) ; + $linefilter[1] = @$filters[5] if ($line =~ /items.itemcallnumber/ ) ; + @linefilter[0] = @$filters[6] if ($line =~ /itemtype/ ) ; + @linefilter[0] = @$filters[7] if ($line =~ /publishercode/ ) ; + $linefilter[0] = @$filters[8] if ($line =~ /publicationyear/ ) ; + $linefilter[1] = @$filters[9] if ($line =~ /publicationyear/ ) ; + @linefilter[0] = @$filters[10] if ($line =~ /items.homebranch/ ) ; + @linefilter[0] = @$filters[11] if ($line =~ /items.location/ ) ; +# + my @colfilter ; + $colfilter[0] = @$filters[0] if ($column =~ /dewey/ ) ; + $colfilter[1] = @$filters[1] if ($column =~ /dewey/ ) ; + $colfilter[0] = @$filters[2] if ($column =~ /lccn/ ) ; + $colfilter[1] = @$filters[3] if ($column =~ /lccn/ ) ; + $colfilter[0] = @$filters[4] if ($column =~ /itemcallnumber/ ) ; + $colfilter[1] = @$filters[5] if ($column =~ /itemcallnumber/ ) ; + @colfilter[0] = @$filters[6] if ($column =~ /itemtype/ ) ; + @colfilter[0] = @$filters[7] if ($column =~ /publishercode/ ) ; + $colfilter[0] = @$filters[8] if ($column =~ /publicationyear/ ) ; + $colfilter[1] = @$filters[9] if ($column =~ /publicationyear/ ) ; + @colfilter[0] = @$filters[10] if ($column =~ /items.homebranch/ ) ; + @colfilter[0] = @$filters[11] if ($column =~ /items.location/ ) ; + +# 1st, loop rows. + my $linefield; + if (($line =~/dewey/) and ($deweydigits)) { + $linefield .="left($line,$deweydigits)"; + } elsif (($line=~/lccn/) and ($lccndigits)) { + $linefield .="left($line,$lccndigits)"; + } elsif (($line=~/items.itemcallnumber/) and ($cotedigits)) { + $linefield .="left($line,$cotedigits)"; + }else { + $linefield .= $line; + } + + + my $strsth; + $strsth .= "select distinctrow $linefield from biblioitems left join items on (items.biblioitemnumber = biblioitems.biblioitemnumber) where $line is not null "; + if ( @linefilter ) { + if ($linefilter[1]){ + $strsth .= " and $line >= ? " ; + $strsth .= " and $line <= ? " ; + } elsif ($linefilter[0]) { + $linefilter[0] =~ s/\*/%/g; + $strsth .= " and $line LIKE ? " ; + } + } + $strsth .=" order by $linefield"; + warn "". $strsth; + + my $sth = $dbh->prepare( $strsth ); + if (( @linefilter ) and ($linefilter[1])){ + $sth->execute($linefilter[0],$linefilter[1]); + } elsif ($linefilter[0]) { + $sth->execute($linefilter[0]); + } else { + $sth->execute; + } + while ( my ($celvalue) = $sth->fetchrow) { + my %cell; + if ($celvalue) { + $cell{rowtitle} = $celvalue; +# } else { +# $cell{rowtitle} = ""; + } + $cell{totalrow} = 0; + push @loopline, \%cell; + } + +# 2nd, loop cols. + my $colfield; + if (($column =~/dewey/) and ($deweydigits)) { + $colfield .="left($column,$deweydigits)"; + }elsif (($column=~/lccn/) and ($lccndigits)) { + $colfield .="left($column,$lccndigits)"; + }elsif (($column=~/itemcallnumber/) and ($cotedigits)) { + $colfield .="left($column,$cotedigits)"; + }else { + $colfield .= $column; + } + + my $strsth2; + $strsth2 .= "select distinctrow $colfield from biblioitems left join items on (items.biblioitemnumber = biblioitems.biblioitemnumber) where $column is not null "; + if (( @colfilter ) and ($colfilter[1])) { + $strsth2 .= " and $column> ? and $column< ?"; + }elsif ($colfilter[0]){ + $colfilter[0] =~ s/\*/%/g; + $strsth2 .= " and $column LIKE ? "; + } + $strsth2 .= " order by $colfield"; + warn "". $strsth2; + my $sth2 = $dbh->prepare( $strsth2 ); + if ((@colfilter) and ($colfilter[1])) { + $sth2->execute($colfilter[0],$colfilter[1]); + } elsif ($colfilter[0]){ + $sth2->execute($colfilter[0]); + } else { + $sth2->execute; + } + while (my ($celvalue) = $sth2->fetchrow) { + my %cell; + my %ft; + if ($celvalue) { + $cell{coltitle} = $celvalue; +# } else { +# $cell{coltitle} = ""; + } + $ft{totalcol} = 0; + push @loopcol, \%cell; + } + + + my $i=0; + my @totalcol; + my $hilighted=-1; + + #Initialization of cell values..... + my %table; +# warn "init table"; + foreach my $row ( @loopline ) { + foreach my $col ( @loopcol ) { +# warn " init table : $row->{rowtitle} / $col->{coltitle} "; + $table{$row->{rowtitle}}->{$col->{coltitle}}=0; + } + $table{$row->{rowtitle}}->{totalrow}=0; + } + +# preparing calculation + my $strcalc .= "SELECT $linefield, $colfield, count( * ) FROM biblioitems LEFT JOIN items ON (items.biblioitemnumber = biblioitems.biblioitemnumber)"; + my $cond=0; + if (@$filters[0]){ + @$filters[0]=~ s/\*/%/g; + $strcalc .= " WHERE dewey >" . @$filters[0] .""; + $cond=1; + } + if (@$filters[1]){ + @$filters[1]=~ s/\*/%/g ; + if ($cond){ + $strcalc .= " AND dewey <" . @$filters[1] .""; + } else { + $strcalc .= " WHERE dewey <" . @$filters[1] ."" ; + $cond=1; + } + + } + if (@$filters[2]){ + @$filters[2]=~ s/\*/%/g ; + if ($cond){ + $strcalc .= " AND lccn >" . @$filters[2] ."" ; + } else { + $strcalc .= " WHERE lccn > " . @$filters[2] ."" ; + $cond=1; + } + } + if (@$filters[3]){ + @$filters[3]=~ s/\*/%/g; + if ($cond){ + $strcalc .= " AND lccn <" . @$filters[3] ."" ; + } else { + $strcalc .= " WHERE lccn <" . @$filters[3] ."" ; + $cond=1; + } + } + if (@$filters[4]){ + @$filters[4]=~ s/\*/%/g ; + if ($cond){ + $strcalc .= " AND items.itemcallnumber >" . @$filters[4] ."" ; + } else { + $strcalc .= " WHERE items.itemcallnumber >" . @$filters[4] ."" ; + $cond=1; + } + } + + if (@$filters[5]){ + @$filters[5]=~ s/\*/%/g; + if ($cond){ + $strcalc .= " AND items.itemcallnumber <" . @$filters[5] ."" ; + } else { + $strcalc .= " WHERE items.itemcallnumber <" . @$filters[5] ."" ; + $cond=1; + } + } + + if (@$filters[6]){ + @$filters[6]=~ s/\*/%/g; + if ($cond){ + $strcalc .= " AND biblioitems.itemtype like '" . @$filters[6] ."'"; + } else { + $strcalc .= " WHERE biblioitems.itemtype like '" . @$filters[6] ."'"; + $cond=1; + } + } + + if (@$filters[7]){ + @$filters[7]=~ s/\*/%/g; + @$filters[7].="%" unless @$filters[7]=~/%/; + if ($cond){ + $strcalc .= " AND biblioitems.publishercode like \"" . @$filters[7] ."\""; + } else { + $strcalc .= " WHERE biblioitems.publishercode like \"" . @$filters[7] ."\""; + $cond=1; + } + } + if (@$filters[8]){ + @$filters[8]=~ s/\*/%/g; + if ($cond){ + $strcalc .= " AND publicationyear >" . @$filters[8] ."" ; + } else { + $strcalc .= " WHERE publicationyear >" . @$filters[8] ."" ; + $cond=1; + } + } + if (@$filters[9]){ + @$filters[9]=~ s/\*/%/g; + if ($cond){ + $strcalc .= " AND publicationyear <" . @$filters[9] .""; + } else { + $strcalc .= " WHERE publicationyear <" . @$filters[9] .""; + $cond=1; + } + } + if (@$filters[10]){ + @$filters[10]=~ s/\*/%/g; + if ($cond){ + $strcalc .= " AND items.homebranch like '" . @$filters[10] ."'"; + } else { + $strcalc .= " WHERE items.homebranch like '" . @$filters[10] ."'"; + $cond=1; + } + } + if (@$filters[11]){ + @$filters[11]=~ s/\*/%/g; + if ($cond){ + $strcalc .= " AND items.location like '" . @$filters[11] ."'" if ( @$filters[11] ); + } else { + $strcalc .= " WHERE items.location like '" . @$filters[11] ."'" if ( @$filters[11] ); + } + } + + $strcalc .= " group by $linefield, $colfield order by $linefield,$colfield"; + warn "". $strcalc; + my $dbcalc = $dbh->prepare($strcalc); + $dbcalc->execute; +# warn "filling table"; + + my $emptycol; + while (my ($row, $col, $value) = $dbcalc->fetchrow) { +# warn "filling table $row / $col / $value "; + $emptycol = 1 if ($col eq undef); + $col = "zzEMPTY" if ($col eq undef); + $row = "zzEMPTY" if ($row eq undef); + + $table{$row}->{$col}+=$value; + $table{$row}->{totalrow}+=$value; + $grantotal += $value; + } + +# my %cell = {rowtitle => 'zzROWEMPTY'}; +# push @loopline,\%cell; +# undef %cell; +# my %cell; +# %cell = {coltitle => "zzEMPTY"}; + push @loopcol,{coltitle => "NULL"} if ($emptycol); + + foreach my $row ( sort keys %table ) { + my @loopcell; + #@loopcol ensures the order for columns is common with column titles + # and the number matches the number of columns + foreach my $col ( @loopcol ) { + my $value =$table{$row}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; + push @loopcell, {value => $value } ; + } + push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row, + 'loopcell' => \@loopcell, + 'hilighted' => ($hilighted >0), + 'totalrow' => $table{$row}->{totalrow} + }; + $hilighted = -$hilighted; + } + +# warn "footer processing"; + foreach my $col ( @loopcol ) { + my $total=0; + foreach my $row ( @looprow ) { + $total += $table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; +# warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle}; + } +# warn "summ for column ".$col->{coltitle}." = ".$total; + push @loopfooter, {'totalcol' => $total}; + } + + + # the header of the table + $globalline{loopfilter}=\@loopfilter; + # the core of the table + $globalline{looprow} = \@looprow; + $globalline{loopcol} = \@loopcol; +# # the foot (totals by borrower type) + $globalline{loopfooter} = \@loopfooter; + $globalline{total}= $grantotal; + $globalline{line} = $line; + $globalline{column} = $column; + push @mainloop,\%globalline; + return \@mainloop; +} + +1; \ No newline at end of file diff --git a/reports/issues_by_borrower_category.plugin b/reports/issues_by_borrower_category.plugin index 868fcbc846..c767bb833e 100644 --- a/reports/issues_by_borrower_category.plugin +++ b/reports/issues_by_borrower_category.plugin @@ -111,62 +111,117 @@ sub calculate { $sthcategories->execute; my %borrowertype; my @categorycodeloop; - while (my ($categorycode,$description) = $sthcategories->fetchrow) { - $borrowertype{$categorycode}->{description} = $description; - $borrowertype{$categorycode}->{total} = 0; - my %categorycode; - $categorycode{categorycode} = $description; - push @categorycodeloop,\%categorycode; - foreach my $itemtype (keys %itemtypes) { - $itemtypes{$itemtype}->{results}->{$categorycode} = 0; - } - $sth->execute($categorycode); - while (my ($itemtype, $total) = $sth->fetchrow) { - $itemtypes{$itemtype}->{results}->{$categorycode} = $total; - $borrowertype{$categorycode}->{total} += $total; - $itemtypes{$itemtype}->{total} += $total; - } - } - my $grantotal = 0; -# build the result + my $categorycode; + my $description; + my $borrower_categorycode =0; my @mainloop; my @itemtypeloop; my @loopborrowertype; + my @loopborrowertotal; my %globalline; my $hilighted=-1; - foreach my $itemtype (keys %itemtypes) { - my @loopitemtype; - foreach my $categorycode (keys %{$itemtypes{$itemtype}->{results}}) { + my $grantotal =0; + #If no Borrower-category selected.... + # Print all + if (!$borrower_category) { + while ( ($categorycode,$description) = $sthcategories->fetchrow) { + $borrowertype{$categorycode}->{description} = $description; + $borrowertype{$categorycode}->{total} = 0; + my %categorycode; + $categorycode{categorycode} = $description; + push @categorycodeloop,\%categorycode; + foreach my $itemtype (keys %itemtypes) { + $itemtypes{$itemtype}->{results}->{$categorycode} = 0; + } + $sth->execute($categorycode); + while (my ($itemtype, $total) = $sth->fetchrow) { + $itemtypes{$itemtype}->{results}->{$categorycode} = $total; + $borrowertype{$categorycode}->{total} += $total; + $itemtypes{$itemtype}->{total} += $total; + $grantotal += $total; + } + } + # build the result + foreach my $itemtype (keys %itemtypes) { + my @loopitemtype; + $sthcategories->execute; + while (($categorycode,$description) = $sthcategories->fetchrow ) { + my %cell; + $cell{issues} = $itemtypes{$itemtype}->{results}->{$categorycode}; + #printf stderr "%s ",$categorycode; + push @loopitemtype,\%cell; + } + #printf stderr "\n"; + my %line; + $line{loopitemtype} = \@loopitemtype; + if ($itemtypes{$itemtype}->{description}) { + $line{itemtype} = $itemtypes{$itemtype}->{description}; + } else { + $line{itemtype} = "$itemtype (no entry in itemtype table)"; + } + $line{hilighted} = 1 if $hilighted eq 1; + $line{totalitemtype} = $itemtypes{$itemtype}->{total}; + $hilighted = -$hilighted; + push @loopborrowertype, \%line; + } + $sthcategories->execute; + while (($categorycode,$description) = $sthcategories->fetchrow ) { + my %line; + $line{issues} = $borrowertype{$categorycode}->{total}; + push @loopborrowertotal, \%line; + } + } else { + # A Borrower_category has been selected + # extracting corresponding data + $borrowertype{$categorycode}->{description} = $borrower_category; + $borrowertype{$categorycode}->{total} = 0; + while (($categorycode,$description) = $sthcategories->fetchrow) { + if ($description =~ /$borrower_category/ ) { + $borrower_categorycode = $categorycode; + my %cc; + $cc{categorycode} = $description; + push @categorycodeloop,\%cc; + foreach my $itemtype (keys %itemtypes) { + $itemtypes{$itemtype}->{results}->{$categorycode} = 0; + } + $sth->execute($categorycode); + while (my ($itemtype, $total) = $sth->fetchrow) { + $itemtypes{$itemtype}->{results}->{$categorycode} = $total; + $borrowertype{$categorycode}->{total} += $total; + $itemtypes{$itemtype}->{total} += $total; + $grantotal +=$total; + } + } + } + # build the result + foreach my $itemtype (keys %itemtypes) { + my @loopitemtype; my %cell; - $cell{issues} = $itemtypes{$itemtype}->{results}->{$categorycode}; - push @loopitemtype,\%cell; + $cell{issues}=$itemtypes{$itemtype}->{results}->{$borrower_categorycode}; + push @loopitemtype, \%cell; + my %line; + $line{loopitemtype} = \@loopitemtype; + if ($itemtypes{$itemtype}->{description}) { + $line{itemtype} = $itemtypes{$itemtype}->{description}; + } else { + $line{itemtype} = "$itemtype (no entry in itemtype table)"; + } + $line{hilighted} = 1 if $hilighted eq 1; + $line{totalitemtype} = $itemtypes{$itemtype}->{total}; + $hilighted = -$hilighted; + push @loopborrowertype, \%line; } - my %line; - $line{loopitemtype} = \@loopitemtype; - if ($itemtypes{$itemtype}->{description}) { - $line{itemtype} = $itemtypes{$itemtype}->{description}; - } else { - $line{itemtype} = "$itemtype (no entry in itemtype table)"; - } - $line{hilighted} = 1 if $hilighted eq 1; - $line{totalitemtype} = $itemtypes{$itemtype}->{total}; - $hilighted = -$hilighted; - push @loopborrowertype, \%line; + my %cell; + $cell{issues} = $borrowertype{$borrower_categorycode}->{total}; + push @loopborrowertotal, \%cell; } # the header of the table $globalline{loopborrowertype} = \@loopborrowertype; # the core of the table $globalline{categorycodeloop} = \@categorycodeloop; # the foot (totals by borrower type) - my @loopborrowertotal; - foreach my $categorycode (keys %borrowertype) { - my %line; - $line{issues} = $borrowertype{$categorycode}->{total}; - push @loopborrowertotal, \%line; - } $globalline{loopborrowertotal} = \@loopborrowertotal; -# $globalline{total} = $grantotal; -# $globalline{borrower_category} = $borrower_category; + $globalline{grantotal}= $grantotal; push @mainloop,\%globalline; return \@mainloop; } diff --git a/reports/issues_stats.pl b/reports/issues_stats.pl new file mode 100755 index 0000000000..9be9fd1348 --- /dev/null +++ b/reports/issues_stats.pl @@ -0,0 +1,532 @@ +#!/usr/bin/perl + +# $Id$ + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use C4::Auth; +use CGI; +use C4::Context; +use HTML::Template; +use C4::Search; +use C4::Output; +use C4::Koha; +use C4::Interface::CGI::Output; +use C4::Circulation::Circ2; +use Date::Manip; + +=head1 NAME + +plugin that shows a stats on borrowers + +=head1 DESCRIPTION + + +=over2 + +=cut + + + +my $input = new CGI; +my $do_it=$input->param('do_it'); +my $fullreportname = "reports/issues_stats.tmpl"; +my $line = $input->param("Line"); +my $column = $input->param("Column"); +my @filters = $input->param("Filter"); +my $podsp = $input->param("DisplayBy"); +my $type = $input->param("PeriodTypeSel"); +my $daysel = $input->param("PeriodDaySel"); +my $monthsel = $input->param("PeriodMonthSel"); +my $calc = $input->param("Cellvalue"); +my $output = $input->param("output"); +my $basename = $input->param("basename"); +my $mime = $input->param("MIME"); +my $del = $input->param("sep"); +#warn "calcul : ".$calc; +my ($template, $borrowernumber, $cookie) + = get_template_and_user({template_name => $fullreportname, + query => $input, + type => "intranet", + authnotrequired => 0, + flagsrequired => {editcatalogue => 1}, + debug => 1, + }); +$template->param(do_it => $do_it); +if ($do_it) { +# Displaying results + my $results = calculate($line, $column, $podsp, $type, $daysel, $monthsel, $calc, \@filters); + if ($output eq "screen"){ +# Printing results to screen + $template->param(mainloop => $results); + output_html_with_http_headers $input, $cookie, $template->output; + exit(1); + } else { +# Printing to a csv file + print $input->header(-type => 'application/vnd.sun.xml.calc', + -attachment=>"$basename.csv", + -filename=>"$basename.csv" ); + my $cols = @$results[0]->{loopcol}; + my $lines = @$results[0]->{looprow}; + my $sep; + $sep =C4::Context->preference("delimiter"); +# header top-right + print @$results[0]->{line} ."/". @$results[0]->{column} .$sep; +# Other header + foreach my $col ( @$cols ) { + print $col->{coltitle}.$sep; + } + print "Total\n"; +# Table + foreach my $line ( @$lines ) { + my $x = $line->{loopcell}; + print $line->{rowtitle}.$sep; + foreach my $cell (@$x) { + print $cell->{value}.$sep; + } + print $line->{totalrow}; + print "\n"; + } +# footer + print "TOTAL"; + $cols = @$results[0]->{loopfooter}; + foreach my $col ( @$cols ) { + print $sep.$col->{totalcol}; + } + print $sep.@$results[0]->{total}; + exit(1); + } +# Displaying choices +} else { + my $dbh = C4::Context->dbh; + my @values; + my %labels; + my %select; + my $req; + $req = $dbh->prepare("select distinctrow categorycode,description from categories order by description"); + $req->execute; + my @select; + push @select,""; + $select{""}=""; + while (my ($value, $desc) =$req->fetchrow) { + push @select, $value; + $select{$value}=$desc; + } + my $CGIBorCat=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -labels => \%select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare( "select distinctrow itemtype,description from itemtypes order by description"); + $req->execute; + undef @select; + undef %select; + push @select,""; + $select{""}=""; + while (my ($value,$desc) =$req->fetchrow) { + push @select, $value; + $select{$value}=$desc; + } + my $CGIItemTypes=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -labels => \%select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare("select distinctrow sort1 from borrowers where sort1 is not null order by sort1"); + $req->execute; + undef @select; + push @select,""; + my $hassort1; + while (my ($value) =$req->fetchrow) { + $hassort1 =1 if ($value); + push @select, $value; + } + my $branches=getbranches(); + my @select_branch; + my %select_branches; + push @select_branch,""; + $select_branches{""} = ""; + foreach my $branch (keys %$branches) { + push @select_branch, $branch; + $select_branches{$branch} = $branches->{$branch}->{'branchname'}; + } + my $CGIBranch=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select_branch, + -labels => \%select_branches, + -size => 1, + -multiple => 0 ); + + my $CGISort1=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + $req = $dbh->prepare("select distinctrow sort2 from borrowers where sort2 is not null order by sort2"); + $req->execute; + undef @select; + push @select,""; + my $hassort2; + my $hglghtsort2; + while (my ($value) =$req->fetchrow) { + $hassort2 =1 if ($value); + $hglghtsort2= !($hassort1); + push @select, $value; + } + my $CGISort2=CGI::scrolling_list( -name => 'Filter', + -id => 'Filter', + -values => \@select, + -size => 1, + -multiple => 0 ); + + my @mime = ( C4::Context->preference("MIME") ); +# foreach my $mime (@mime){ +# warn "".$mime; +# } + + my $CGIextChoice=CGI::scrolling_list( + -name => 'MIME', + -id => 'MIME', + -values => \@mime, + -size => 1, + -multiple => 0 ); + + my @dels = ( C4::Context->preference("delimiter") ); + my $CGIsepChoice=CGI::scrolling_list( + -name => 'sep', + -id => 'sep', + -values => \@dels, + -size => 1, + -multiple => 0 ); + + $template->param( + CGIBorCat => $CGIBorCat, + CGIItemType => $CGIItemTypes, + CGIBranch => $CGIBranch, + hassort1=> $hassort1, + hassort2=> $hassort2, + HlghtSort2 => $hglghtsort2, + CGISort1 => $CGISort1, + CGISort2 => $CGISort2, + CGIextChoice => $CGIextChoice, + CGIsepChoice => $CGIsepChoice + ); +output_html_with_http_headers $input, $cookie, $template->output; +} + + + + +sub calculate { + my ($line, $column, $dsp, $type,$daysel,$monthsel ,$process, $filters) = @_; + my @mainloop; + my @loopfooter; + my @loopcol; + my @loopline; + my @looprow; + my %globalline; + my $grantotal =0; +# extract parameters + my $dbh = C4::Context->dbh; + +# Filters +# Checking filters +# + my @loopfilter; + for (my $i=0;$i<=6;$i++) { + my %cell; + if ( @$filters[$i] ) { + if (($i==1) and (@$filters[$i-1])) { + $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ; + } + $cell{filter} .= @$filters[$i]; + $cell{crit} .="Period From" if ($i==0); + $cell{crit} .="Period To" if ($i==1); + $cell{crit} .="Borrower Cat" if ($i==2); + $cell{crit} .="Doc Type" if ($i==3); + $cell{crit} .="Branch" if ($i==4); + $cell{crit} .="Sort1" if ($i==5); + $cell{crit} .="Sort2" if ($i==6); + push @loopfilter, \%cell; + } + } + push @loopfilter,{crit=>"Issue|Return ",filter=>$type}; + push @loopfilter,{crit=>"Display by ",filter=>$dsp} if ($dsp); + push @loopfilter,{crit=>"Select Day ",filter=>$daysel} if ($daysel); + push @loopfilter,{crit=>"Select Month ",filter=>$daysel} if ($monthsel); + + + my @linefilter; +# warn "filtres ".@filters[0]; +# warn "filtres ".@filters[1]; +# warn "filtres ".@filters[2]; +# warn "filtres ".@filters[3]; + + $linefilter[0] = @$filters[0] if ($line =~ /datetime/ ) ; + $linefilter[1] = @$filters[1] if ($line =~ /datetime/ ) ; + $linefilter[0] = @$filters[2] if ($line =~ /category/ ) ; + $linefilter[0] = @$filters[3] if ($line =~ /itemtype/ ) ; + $linefilter[0] = @$filters[4] if ($line =~ /branch/ ) ; +# $linefilter[0] = @$filters[11] if ($line =~ /sort2/ ) ; + $linefilter[0] = @$filters[5] if ($line =~ /sort1/ ) ; + $linefilter[0] = @$filters[6] if ($line =~ /sort2/ ) ; +#warn "filtre lignes".$linefilter[0]." ".$linefilter[1]; +# + my @colfilter ; + $colfilter[0] = @$filters[0] if ($column =~ /datetime/) ; + $colfilter[1] = @$filters[1] if ($column =~ /datetime/) ; + $colfilter[0] = @$filters[2] if ($column =~ /category/) ; + $colfilter[0] = @$filters[3] if ($column =~ /itemtype/) ; + $colfilter[0] = @$filters[4] if ($column =~ /branch/ ) ; + $colfilter[0] = @$filters[5] if ($column =~ /sort1/ ) ; + $colfilter[0] = @$filters[6] if ($column =~ /sort2/ ) ; +#warn "filtre col ".$colfilter[0]." ".$colfilter[1]; + +# 1st, loop rows. + my $linefield; + if (($line =~/datetime/) and ($dsp == 1)) { + #Display by day + $linefield .="concat(weekday($line),' ',dayname($line))"; + } elsif (($line=~/datetime/) and ($dsp == 2)) { + #Display by Month + $linefield .="monthname($line)"; + } elsif (($line=~/datetime/) and ($dsp == 3)) { + #Display by Year + $linefield .="Year($line)"; + } elsif ($line=~/datetime/) { + $linefield .= 'date_format(`datetime`,"%Y-%m-%d")'; + } else { + $linefield .= $line; + } + my $lineorder = $linefield; + $lineorder = "weekday($line)" if $lineorder =~ "^dayname"; + + my $strsth; + $strsth .= "select distinctrow $linefield from statistics, borrowers where (statistics.borrowernumber=borrowers.borrowernumber) and $line is not null "; + + if ($line=~/datetime/) { + if ($linefilter[1] and ($linefilter[0])){ + $strsth .= " and $line between ? and ? " ; + } elsif ($linefilter[1]) { + $strsth .= " and $line < ? " ; + } elsif ($linefilter[0]) { + $strsth .= " and $line > ? " ; + } + $strsth .= " and type ='".$type."' " if $type; + $strsth .= " and dayname(datetime) ='". $daysel ."' " if $daysel; + $strsth .= " and monthname(datetime) ='". $monthsel ."' " if $monthsel; + } elsif ($linefilter[0]) { + $linefilter[0] =~ s/\*/%/g; + $strsth .= " and $line LIKE ? " ; + } + $strsth .=" group by $linefield"; + $strsth .=" order by $lineorder"; + warn "". $strsth; + + my $sth = $dbh->prepare( $strsth ); + if (( @linefilter ) and ($linefilter[1])){ + $sth->execute("'".$linefilter[0]."'","'".$linefilter[1]."'"); + } elsif ($linefilter[0]) { + $sth->execute($linefilter[0]); + } else { + $sth->execute; + } + + while ( my ($celvalue) = $sth->fetchrow) { + my %cell; + if ($celvalue) { + $cell{rowtitle} = $celvalue; + } else { + $cell{rowtitle} = ""; + } + $cell{totalrow} = 0; + push @loopline, \%cell; + } + +# 2nd, loop cols. + my $colfield; + if (($column =~/datetime/) and ($dsp == 1)) { + #Display by day + $colfield .="dayname($column)"; + } elsif (($column=~/datetime/) and ($dsp == 2)) { + #Display by Month + $colfield .="monthname($column)"; + } elsif (($column=~/datetime/) and ($dsp == 3)) { + #Display by Year + $colfield .="Year($column)"; + } elsif ($column=~/datetime/) { + $colfield .='date_format(`datetime`,"%Y-%m-%d")'; + } else { + $colfield .= $column; + } + + my $strsth2; + $strsth2 .= "select distinctrow $colfield from statistics, borrowers where (statistics.borrowernumber=borrowers.borrowernumber) and $column is not null "; + + if ($column=~/datetime/){ + if (($colfilter[1]) and ($colfilter[0])){ + $strsth2 .= " and $column between ? and ? " ; + } elsif ($colfilter[1]) { + $strsth2 .= " and $column < ? " ; + } elsif ($colfilter[0]) { + $strsth2 .= " and $column > ? " ; + } + $strsth2 .= " and type ='".$type."' " if $type; + $strsth2 .= " and dayname(datetime) ='". $daysel ."' " if $daysel; + $strsth2 .= " and monthname(datetime) ='". $monthsel ."' " if $monthsel; + } elsif ($colfilter[0]) { + $colfilter[0] =~ s/\*/%/g; + $strsth2 .= " and $column LIKE ? " ; + } + $strsth2 .=" group by $colfield"; + $strsth2 .=" order by $colfield"; +# warn "". $strsth2; + + my $sth2 = $dbh->prepare( $strsth2 ); + if (( @colfilter ) and ($colfilter[1])){ + $sth2->execute("'".$colfilter[0]."'","'".$colfilter[1]."'"); + } elsif ($colfilter[0]) { + $sth2->execute($colfilter[0]); + } else { + $sth2->execute; + } + + + while (my ($celvalue) = $sth2->fetchrow) { + my %cell; + my %ft; +# warn "coltitle :".$celvalue; + $cell{coltitle} = $celvalue; + $ft{totalcol} = 0; + push @loopcol, \%cell; + } +# warn "fin des titres colonnes"; + + my $i=0; + my @totalcol; + my $hilighted=-1; + + #Initialization of cell values..... + my %table; +# warn "init table"; + foreach my $row ( @loopline ) { + foreach my $col ( @loopcol ) { +# warn " init table : $row->{rowtitle} / $col->{coltitle} "; + $table{$row->{rowtitle}}->{$col->{coltitle}}=0; + } + $table{$row->{rowtitle}}->{totalrow}=0; + } + +# preparing calculation + my $strcalc ; + + $strcalc .= "SELECT $linefield, $colfield, "; + $strcalc .= "COUNT( * ) " if ($process ==1); + if ($process ==3){ + my $rqbookcount = $dbh->prepare("SELECT count(*) FROM items"); + $rqbookcount->execute; + my ($bookcount) = $rqbookcount->fetchrow; + $strcalc .= "100*(COUNT(itemnumber))/ $bookcount " ; + } + $strcalc .= "FROM statistics,borrowers where (statistics.borrowernumber=borrowers.borrowernumber) "; + + @$filters[0]=~ s/\*/%/g if (@$filters[0]); + $strcalc .= " AND statistics.datetime > '" . @$filters[0] ."'" if ( @$filters[0] ); + @$filters[1]=~ s/\*/%/g if (@$filters[1]); + $strcalc .= " AND statistics.datetime < '" . @$filters[1] ."'" if ( @$filters[1] ); + @$filters[2]=~ s/\*/%/g if (@$filters[2]); + $strcalc .= " AND borrowers.categorycode like '" . @$filters[2] ."'" if ( @$filters[2] ); + @$filters[3]=~ s/\*/%/g if (@$filters[3]); + $strcalc .= " AND statistics.itemtype like '" . @$filters[3] ."'" if ( @$filters[3] ); + @$filters[4]=~ s/\*/%/g if (@$filters[4]); + $strcalc .= " AND statistics.branch like '" . @$filters[4] ."'" if ( @$filters[4] ); + @$filters[5]=~ s/\*/%/g if (@$filters[5]); + $strcalc .= " AND borrowers.sort1 like '" . @$filters[5] ."'" if ( @$filters[5] ); + @$filters[6]=~ s/\*/%/g if (@$filters[6]); + $strcalc .= " AND borrowers.sort2 like '" . @$filters[6] ."'" if ( @$filters[6] ); + $strcalc .= " AND dayname(datetime) like '" . $daysel ."'" if ( $daysel ); + $strcalc .= " AND monthname(datetime) like '" . $monthsel ."'" if ( $monthsel ); + $strcalc .= " AND statistics.type like '" . $type ."'" if ( $type ); + + $strcalc .= " group by $linefield, $colfield order by $lineorder,$colfield"; + warn "". $strcalc; + my $dbcalc = $dbh->prepare($strcalc); + $dbcalc->execute; +# warn "filling table"; + my $emptycol; + while (my ($row, $col, $value) = $dbcalc->fetchrow) { +# warn "filling table $row / $col / $value "; + $emptycol = 1 if ($col eq undef); + $col = "zzEMPTY" if ($col eq undef); + $row = "zzEMPTY" if ($row eq undef); + + $table{$row}->{$col}+=$value; + $table{$row}->{totalrow}+=$value; + $grantotal += $value; + } + push @loopcol,{coltitle => "NULL"} if ($emptycol); + + foreach my $row ( sort keys %table ) { + my @loopcell; + #@loopcol ensures the order for columns is common with column titles + # and the number matches the number of columns + foreach my $col ( @loopcol ) { + my $value =$table{$row}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; + push @loopcell, {value => $value } ; + } + push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row, + 'loopcell' => \@loopcell, + 'hilighted' => ($hilighted >0), + 'totalrow' => $table{$row}->{totalrow} + }; + $hilighted = -$hilighted; + } + +# warn "footer processing"; + foreach my $col ( @loopcol ) { + my $total=0; + foreach my $row ( @looprow ) { + $total += $table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}}; +# warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle}; + } +# warn "summ for column ".$col->{coltitle}." = ".$total; + push @loopfooter, {'totalcol' => $total}; + } + + + # the header of the table + $globalline{loopfilter}=\@loopfilter; + # the core of the table + $globalline{looprow} = \@looprow; + $globalline{loopcol} = \@loopcol; +# # the foot (totals by borrower type) + $globalline{loopfooter} = \@loopfooter; + $globalline{total}= $grantotal; + $globalline{line} = $line; + $globalline{column} = $column; + push @mainloop,\%globalline; + return \@mainloop; +} + +1; \ No newline at end of file diff --git a/reports/manager2.pl b/reports/manager2.pl new file mode 100755 index 0000000000..4814b5fce4 --- /dev/null +++ b/reports/manager2.pl @@ -0,0 +1,54 @@ +#!/usr/bin/perl + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use CGI; +use C4::Auth; +use C4::Context; +use C4::Output; +use C4::Interface::CGI::Output; +use C4::Circulation::Circ2; +use HTML::Template; + +my $input = new CGI; +my $report_name=$input->param("report_name"); +my $do_it=$input->param('do_it'); +my $fullreportname = "reports/".$report_name.".tmpl"; +my $line = $input->param("Line"); +my $column = $input->param("Column"); +my @filters = $input->param("Filter"); +my ($template, $borrowernumber, $cookie) + = get_template_and_user({template_name => $fullreportname, + query => $input, + type => "intranet", + authnotrequired => 0, + flagsrequired => {editcatalogue => 1}, + debug => 1, + }); +$template->param(do_it => $do_it, + report_name => $report_name); +my $plugin = "./".$report_name.".plugin"; +require $plugin; +if ($do_it) { + my $results = calculate($line, $column, \@filters); + $template->param(mainloop => $results); +} else { + $template = set_parameters($template); +} +output_html_with_http_headers $input, $cookie, $template->output; diff --git a/reports/reports-home.pl b/reports/reports-home.pl new file mode 100644 index 0000000000..a220183ca2 --- /dev/null +++ b/reports/reports-home.pl @@ -0,0 +1,20 @@ +#!/usr/bin/perl + +use strict; +use CGI; +use C4::Auth; +use C4::Output; +use C4::Interface::CGI::Output; +use C4::Context; +use HTML::Template; + +my $query = new CGI; +my ($template, $loggedinuser, $cookie) += get_template_and_user({template_name => "reports/reports-home.tmpl", + query => $query, + type => "intranet", + authnotrequired => 0, + flagsrequired => {catalogue => 1}, + debug => 1, + }); +output_html_with_http_headers $query, $cookie, $template->output;