Adding Stats on Catalogue
authorhdl <hdl>
Wed, 23 Feb 2005 12:56:55 +0000 (12:56 +0000)
committerhdl <hdl>
Wed, 23 Feb 2005 12:56:55 +0000 (12:56 +0000)
reports/catalogue_stats.pl [new file with mode: 0755]

diff --git a/reports/catalogue_stats.pl b/reports/catalogue_stats.pl
new file mode 100755 (executable)
index 0000000..49b272a
--- /dev/null
@@ -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;
\ No newline at end of file