hdl
18 years ago
1 changed files with 485 additions and 0 deletions
@ -0,0 +1,485 @@ |
|||
#!/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', -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 "\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 distinctrow left(dewey,3) from biblioitems"); |
|||
$req->execute; |
|||
my @select; |
|||
push @select,""; |
|||
while (my ($value) =$req->fetchrow) { |
|||
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"); |
|||
$req->execute; |
|||
undef @select; |
|||
push @select,""; |
|||
while (my ($value) =$req->fetchrow) { |
|||
push @select, $value; |
|||
} |
|||
my $CGIlccn=CGI::scrolling_list( -name => 'Filter', |
|||
-id => 'Filter', |
|||
-values => \@select, |
|||
-size => 1, |
|||
-multiple => 0 ); |
|||
|
|||
$req = $dbh->prepare("select distinctrow left(itemcolnumber,5) from items"); |
|||
$req->execute; |
|||
undef @select; |
|||
push @select,""; |
|||
while (my ($value) =$req->fetchrow) { |
|||
push @select, $value; |
|||
} |
|||
my $CGIcote=CGI::scrolling_list( -name => 'Filter', |
|||
-id => 'Filter', |
|||
-values => \@select, |
|||
-size => 1, |
|||
-multiple => 0 ); |
|||
|
|||
undef @select; |
|||
push @select,""; |
|||
for (my $i=1950;$i<=2050;$i++) { |
|||
push @select, $i; |
|||
} |
|||
my $CGIpublicationyear=CGI::scrolling_list( -name => 'Filter', |
|||
-id => 'Filter', |
|||
-values => \@select, |
|||
-size => 1, |
|||
-multiple => 0 ); |
|||
|
|||
$req = $dbh->prepare("select distinctrow itemtype from biblioitems"); |
|||
$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 publishercode from biblioitems"); |
|||
$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"); |
|||
$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(CGIFromDeweyClass => $CGIdewey, |
|||
CGIToDeweyClass => $CGIdewey, |
|||
CGIFromLoCClass => $CGIlccn, |
|||
CGIToLoCClass => $CGIlccn, |
|||
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 = @$filters[0] if ($line =~ /dewey/ ) ; |
|||
$linefilter = @$filters[1] if ($line =~ /dewey/ ) ; |
|||
$linefilter = @$filters[2] if ($line =~ /lccn/ ) ; |
|||
$linefilter = @$filters[3] if ($line =~ /lccn/ ) ; |
|||
$linefilter = @$filters[4] if ($line =~ /itemcolnumber/ ) ; |
|||
$linefilter = @$filters[5] if ($line =~ /itemcolnumber/ ) ; |
|||
$linefilter = @$filters[6] if ($line =~ /itemtype/ ) ; |
|||
$linefilter = @$filters[7] if ($line =~ /publishercode/ ) ; |
|||
$linefilter = @$filters[8] if ($line =~ /publicationyear/ ) ; |
|||
$linefilter = @$filters[9] if ($line =~ /publicationyear/ ) ; |
|||
$linefilter = @$filters[10] if ($line =~ /items.homebranch/ ) ; |
|||
$linefilter = @$filters[11] if ($line =~ /items.location/ ) ; |
|||
# |
|||
my $colfilter = ""; |
|||
$colfilter = @$filters[0] if ($column =~ /dewey/ ) ; |
|||
$colfilter = @$filters[1] if ($column =~ /dewey/ ) ; |
|||
$colfilter = @$filters[2] if ($column =~ /lccn/ ) ; |
|||
$colfilter = @$filters[3] if ($column =~ /lccn/ ) ; |
|||
$colfilter = @$filters[4] if ($column =~ /itemcolnumber/ ) ; |
|||
$colfilter = @$filters[5] if ($column =~ /itemcolnumber/ ) ; |
|||
$colfilter = @$filters[6] if ($column =~ /itemtype/ ) ; |
|||
$colfilter = @$filters[7] if ($column =~ /publishercode/ ) ; |
|||
$colfilter = @$filters[8] if ($column =~ /publicationyear/ ) ; |
|||
$colfilter = @$filters[9] if ($column =~ /publicationyear/ ) ; |
|||
$colfilter = @$filters[10] if ($column =~ /items.homebranch/ ) ; |
|||
$colfilter = @$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=~/itemcolnumber/) and ($cotedigits)) { |
|||
$linefield .="left($line,$cotedigits)"; |
|||
}else { |
|||
$linefield .= $line; |
|||
} |
|||
|
|||
|
|||
my $strsth; |
|||
$strsth .= "select distinctrow $linefield from biblioitems, items where (items.biblioitemnumber = biblioitems.biblioitemnumber) and $line is not null "; |
|||
$linefilter =~ s/\*/%/g; |
|||
if ( $linefilter ) { |
|||
$strsth .= " and $linefield LIKE ? " ; |
|||
} |
|||
$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 =~/dewey/) and ($deweydigits)) { |
|||
$colfield .="left($column,$deweydigits)"; |
|||
}elsif (($column=~/lccn/) and ($lccndigits)) { |
|||
$colfield .="left($column,$lccndigits)"; |
|||
}elsif (($column=~/itemcolnumber/) and ($cotedigits)) { |
|||
$colfield .="left($column,$cotedigits)"; |
|||
}else { |
|||
$colfield .= $column; |
|||
} |
|||
|
|||
my $strsth2; |
|||
$colfilter =~ s/\*/%/g; |
|||
$strsth2 .= "select distinctrow $colfield from biblioitems, items where (items.biblioitemnumber = biblioitems.biblioitemnumber) and $column is not null "; |
|||
if ( $colfilter ) { |
|||
$strsth2 .= " and $colfield LIKE ? "; |
|||
} |
|||
$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; |
|||
$cell{coltitle} = $celvalue; |
|||
$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, items WHERE (items.biblioitemnumber = biblioitems.biblioitemnumber) AND $line is not null AND $column is not null"; |
|||
@$filters[0]=~ s/\*/%/g if (@$filters[0]); |
|||
$strcalc .= " AND dewey >" . @$filters[0] ."" if ( @$filters[0] ); |
|||
@$filters[1]=~ s/\*/%/g if (@$filters[1]); |
|||
$strcalc .= " AND dewey <" . @$filters[1] ."" if ( @$filters[1] ); |
|||
@$filters[2]=~ s/\*/%/g if (@$filters[2]); |
|||
$strcalc .= " AND lccn >" . @$filters[2] ."" if ( @$filters[2] ); |
|||
@$filters[3]=~ s/\*/%/g if (@$filters[3]); |
|||
$strcalc .= " AND lccn <" . @$filters[3] ."" if ( @$filters[3] ); |
|||
@$filters[4]=~ s/\*/%/g if (@$filters[4]); |
|||
$strcalc .= " AND items.itemcolnumber >" . @$filters[4] ."" if ( @$filters[4] ); |
|||
@$filters[5]=~ s/\*/%/g if (@$filters[5]); |
|||
$strcalc .= " AND items.itemcolnumber <" . @$filters[5] ."" if ( @$filters[5] ); |
|||
@$filters[6]=~ s/\*/%/g if (@$filters[6]); |
|||
$strcalc .= " AND biblioitems.itemtype like '" . @$filters[6] ."'" if ( @$filters[6] ); |
|||
@$filters[7]=~ s/\*/%/g if (@$filters[7]); |
|||
$strcalc .= " AND biblioitems.publishercode like '" . @$filters[7] ."'" if ( @$filters[7] ); |
|||
@$filters[8]=~ s/\*/%/g if (@$filters[8]); |
|||
$strcalc .= " AND publicationyear >" . @$filters[8] ."" if ( @$filters[8] ); |
|||
@$filters[9]=~ s/\*/%/g if (@$filters[9]); |
|||
$strcalc .= " AND publicationyear <" . @$filters[9] ."" if ( @$filters[9] ); |
|||
@$filters[10]=~ s/\*/%/g if (@$filters[10]); |
|||
$strcalc .= " AND items.homebranch like '" . @$filters[10] ."'" if ( @$filters[10] ); |
|||
@$filters[11]=~ s/\*/%/g if (@$filters[11]); |
|||
$strcalc .= " AND 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"; |
|||
while (my ($row, $col, $value) = $dbcalc->fetchrow) { |
|||
# warn "filling table $row / $col / $value "; |
|||
$table{$row}->{$col}=$value; |
|||
$table{$row}->{totalrow}+=$value; |
|||
$grantotal += $value; |
|||
} |
|||
|
|||
foreach my $row ( sort keys %table ) { |
|||
my @loopcell; |
|||
#@loopcol ensures the order for columns is common with column titles |
|||
foreach my $col ( @loopcol ) { |
|||
push @loopcell, {value => $table{$row}->{$col->{coltitle}}} ; |
|||
} |
|||
push @looprow,{ 'rowtitle' => $row, |
|||
'loopcell' => \@loopcell, |
|||
'hilighted' => 1 , |
|||
'totalrow' => $table{$row}->{totalrow} |
|||
}; |
|||
$hilighted = -$hilighted; |
|||
} |
|||
|
|||
foreach my $col ( @loopcol ) { |
|||
my $total=0; |
|||
foreach my $row ( @loopline ) { |
|||
$total += $table{$row->{rowtitle}}->{$col->{coltitle}}; |
|||
} |
|||
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; |
|||
Loading…
Reference in new issue