reports/borrowers_stats.plugin

   1 #!/usr/bin/perl
   2
   3 # $Id$
   4
   5 # Copyright 2000-2002 Katipo Communications
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along with
  19 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  20 # Suite 330, Boston, MA  02111-1307 USA
  21
  22 use strict;
  23 use C4::Auth;
  24 use CGI;
  25 use C4::Context;
  26 use HTML::Template;
  27 use C4::Search;
  28 use C4::Output;
  29 use C4::Koha;
  30
  31 =head1 NAME
  32
  33 plugin that shows a stats on borrowers
  34
  35 =head1 DESCRIPTION
  36
  37
  38 =over2
  39
  40 =cut
  41
  42 sub set_parameters {
  43         my ($template) = @_;
  44         my $dbh = C4::Context->dbh;
  45         return $template;
  46 }
  47
  48 sub calculate {
  49         my ($line, $column, $filters) = @_;
  50         my @results =();
  51         my @mainloop;
  52         my @loopfooter;
  53         my @loopcol;
  54         my @looprow;
  55         my %globalline;
  56         my $grantotal =0;
  57 # extract parameters
  58         my $dbh = C4::Context->dbh;
  59 # build the SQL query & execute it
  60         my $linefilter = "";
  61         $linefilter = @$filters[0] if ($line =~ /categorycode/ )  ;
  62         $linefilter = @$filters[4] if ($line =~ /zipcode/ )  ;
  63         $linefilter = @$filters[2] if ($line =~ /sort1/ ) ;
  64         $linefilter = @$filters[3] if ($line =~ /sort2/ ) ;
  65
  66         my $colfilter = "";
  67         $colfilter = @$filters[0] if ($column =~ /categorycode/);
  68         $colfilter = @$filters[4] if ($column =~ /zipcode/);
  69         $colfilter = @$filters[2] if ($column =~ /sort1/);
  70         $colfilter = @$filters[3] if ($column =~ /sort2/);
  71
  72         my @loopfilter;
  73         for (my $i=0;$i<=4;$i++) {
  74                 my %cell;
  75                 if ( @$filters[$i] ) {
  76                         $cell{filter} .= @$filters[$i];
  77                         $cell{crit} .="Category Code " if ($i==0);
  78                         $cell{crit} .="Status" if ($i==1);
  79                         $cell{crit} .="Sort1" if ($i==2);
  80                         $cell{crit} .="Sort2" if ($i==3);
  81                         $cell{crit} .="Zip Code" if ($i==4);
  82                         push @loopfilter, \%cell;
  83                 }
  84         }
  85 # 1st, loop rows.
  86 #problem with NULL Values.
  87         my $strsth;
  88         $strsth .= "select distinctrow $line from borrowers";
  89         $linefilter =~ s/\*/%/g;
  90         if ( $linefilter ) {
  91                 $strsth .= " where $line LIKE ? and $line is not null" ;
  92         } else {
  93                 $strsth .= " where $line is not null" ;
  94         }
  95         $strsth .=" order by $line";
  96         my $sth = $dbh->prepare( $strsth );
  97         if ( $linefilter ) {
  98                 $sth->execute($linefilter);
  99         } else {
 100                 $sth->execute;
 101         }
 102         while ( my ($celvalue) = $sth->fetchrow) {
 103                 my %cell;
 104                 if ($celvalue) {
 105                         $cell{rowtitle} = $celvalue;
 106                 } else {
 107                         $cell{rowtitle} = "";
 108                 }
 109                 $cell{totalrow} = 0;
 110                 push @looprow, \%cell;
 111         }
 112
 113 # 2nd, loop cols.
 114         my $strsth2;
 115         $colfilter =~ s/\*/%/g;
 116         $strsth2 .= "select distinctrow $column from borrowers";
 117         if ( $colfilter ) {
 118                 $strsth2 .= " where $column LIKE ? and $column is not null";
 119         } else {
 120                 $strsth2 .= " where $column is not null";
 121         }
 122         $strsth2 .= " order by $column";
 123         my $sth2 = $dbh->prepare( $strsth2 );
 124         if ($colfilter) {
 125                 $sth2->execute($colfilter);
 126         } else {
 127                 $sth2->execute;
 128         }
 129         while (my ($celvalue) = $sth2->fetchrow) {
 130                 my %cell;
 131                 my %ft;
 132                 $cell{coltitle} = $celvalue;
 133                 $ft{totalcol} = 0;
 134                 push @loopcol, \%cell;
 135                 push @loopfooter, \%ft;
 136         }
 137 # now, parse each category. Before filling the result array, fill it with 0 to have every itemtype column.
 138         my $strcalc .= "SELECT  count( * ) FROM borrowers WHERE $line = ? and $column= ? ";
 139         $strcalc .= " AND categorycode like '" . @$filters[1] ."%' " if ( @$filters[1] );
 140         $strcalc .= " AND sort1 like ' " . @$filters[2] ."%'" if ( @$filters[2] );
 141         $strcalc .= " AND sort2 like ' " . @$filters[3] ."%'" if ( @$filters[3] );
 142         $strcalc .= " AND zipcode like ' " . @$filters[4] ."%'" if ( @$filters[4] );
 143         my $dbcalc = $dbh->prepare($strcalc);
 144         my $i=0;
 145         my @totalcol;
 146         my $hilighted=-1;
 147         # for each line
 148         for (my $i=0; $i<=$#looprow; $i++) {
 149                 my $row = $looprow[$i]->{'rowtitle'};
 150                 my @loopcell;
 151                 my $totalrow=0;
 152                 # for each column
 153                 for (my $j=0;$j<=$#loopcol;$j++) {
 154                         my $col = $loopcol[$j]->{'coltitle'};
 155                         $dbcalc->execute($row,$col);
 156                         my ($value) = $dbcalc->fetchrow;
 157 #                       warn "$row / $col / $value";
 158                         $totalrow += $value;
 159                         $grantotal += $value;
 160                         $loopfooter[$j]->{'totalcol'} +=$value;
 161                         push @loopcell,{value => $value};
 162                 }
 163                 $looprow[$i]->{'totalrow'}=$totalrow;
 164                 $looprow[$i]->{'loopcell'}=\@loopcell;
 165                 $looprow[$i]->{'hilighted'} = 1 if $hilighted eq 1;
 166                 $hilighted = -$hilighted;
 167         }
 168
 169 #       # the header of the table
 170         $globalline{loopfilter}=\@loopfilter;
 171         $globalline{looprow} = \@looprow;
 172 #       # the core of the table
 173         $globalline{loopcol} = \@loopcol;
 174 #       # the foot (totals by borrower type)
 175         $globalline{loopfooter} = \@loopfooter;
 176         $globalline{total}= $grantotal;
 177         $globalline{line} = $line;
 178         $globalline{column} = $column;
 179         push @mainloop,\%globalline;
 180         return \@mainloop;
 181 }
 182
 183 1;