5 # Copyright 2000-2002 Katipo Communications
7 # This file is part of Koha.
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
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.
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
30 use C4::Interface::CGI::Output;
31 use C4::Circulation::Circ2;
35 plugin that shows a stats on borrowers
45 my $do_it=$input->param('do_it');
46 my $fullreportname = "reports/borrowers_stats.tmpl";
47 my $line = $input->param("Line");
48 my $column = $input->param("Column");
49 my @filters = $input->param("Filter");
50 my $digits = $input->param("digits");
51 my $borstat = $input->param("status");
52 my ($template, $borrowernumber, $cookie)
53 = get_template_and_user({template_name => $fullreportname,
57 flagsrequired => {editcatalogue => 1},
60 $template->param(do_it => $do_it);
62 my $results = calculate($line, $column, $digits, $borstat, \@filters);
63 $template->param(mainloop => $results);
64 # print $input->header(-type => 'application/vnd.ms-excel', -name=>"export.csv");
65 # my $lines = @$results[0]->{looprow};
66 # foreach my $line (@$lines) {
67 # my $x = $line->{loopcell};
68 # foreach my $cell (@$x) {
69 # print $cell->{value}.";";
74 my $dbh = C4::Context->dbh;
78 $req = $dbh->prepare( "select categorycode, description from categories");
82 push @select_catcode,"";
83 $select_catcode{""} = "";
84 while (my ($catcode, $description) =$req->fetchrow) {
85 push @select_catcode, $catcode;
86 $select_catcode{$catcode} = $description
88 my $CGICatCode=CGI::scrolling_list( -name => 'Filter',
90 -values => \@select_catcode,
91 -labels => \%select_catcode,
95 $req = $dbh->prepare( "select distinctrow sort1 from borrowers");
98 push @select_sort1,"";
99 while (my ($value) =$req->fetchrow) {
100 push @select_sort1, $value;
102 my $CGIsort1=CGI::scrolling_list( -name => 'Filter',
104 -values => \@select_sort1,
108 $req = $dbh->prepare( "select distinctrow sort2 from borrowers");
111 push @select_sort2,"";
112 while (my ($value) =$req->fetchrow) {
113 push @select_sort2, $value;
115 my $CGIsort2=CGI::scrolling_list( -name => 'Filter',
117 -values => \@select_sort2,
120 $template->param(CGICatcode => $CGICatCode,
121 CGISort1 => $CGIsort1,
122 CGISort2 => $CGIsort2
126 output_html_with_http_headers $input, $cookie, $template->output;
131 my ($line, $column, $digits, $status, $filters) = @_;
139 my $dbh = C4::Context->dbh;
143 $linefilter = @$filters[0] if ($line =~ /categorycode/ ) ;
144 $linefilter = @$filters[1] if ($line =~ /zipcode/ ) ;
145 $linefilter = @$filters[2] if ($line =~ /sort1/ ) ;
146 $linefilter = @$filters[3] if ($line =~ /sort2/ ) ;
149 $colfilter = @$filters[0] if ($column =~ /categorycode/);
150 $colfilter = @$filters[1] if ($column =~ /zipcode/);
151 $colfilter = @$filters[2] if ($column =~ /sort1/);
152 $colfilter = @$filters[3] if ($column =~ /sort2/);
155 for (my $i=0;$i<=3;$i++) {
157 if ( @$filters[$i] ) {
158 $cell{filter} .= @$filters[$i];
159 $cell{crit} .="Category Code " if ($i==0);
160 $cell{crit} .="Zip Code" if ($i==1);
161 $cell{crit} .="Sort1" if ($i==2);
162 $cell{crit} .="Sort2" if ($i==3);
163 push @loopfilter, \%cell;
167 push @loopfilter,{crit=>"Status",filter=>$status}
170 #problem with NULL Values.
172 $strsth .= "select distinctrow $line from borrowers where $line is not null ";
173 $linefilter =~ s/\*/%/g;
175 $strsth .= " and $line LIKE ? " ;
177 $strsth .= " and $status='1' " if ($status);
178 $strsth .=" order by $line";
181 my $sth = $dbh->prepare( $strsth );
183 $sth->execute($linefilter);
187 while ( my ($celvalue) = $sth->fetchrow) {
190 $cell{rowtitle} = $celvalue;
192 $cell{rowtitle} = "";
195 push @looprow, \%cell;
200 $colfilter =~ s/\*/%/g;
201 $strsth2 .= "select distinctrow $column from borrowers where $column is not null";
203 $strsth2 .= " and $column LIKE ? ";
205 $strsth2 .= " and $status='1' " if ($status);
206 $strsth2 .= " order by $column";
208 my $sth2 = $dbh->prepare( $strsth2 );
210 $sth2->execute($colfilter);
214 while (my ($celvalue) = $sth2->fetchrow) {
217 $cell{coltitle} = $celvalue;
219 push @loopcol, \%cell;
220 push @loopfooter, \%ft;
222 # now, parse each category. Before filling the result array, fill it with 0 to have every itemtype column.
223 my $strcalc .= "SELECT count( * ) FROM borrowers WHERE $line = ? and $column= ? ";
224 $strcalc .= " AND categorycode like '" . @$filters[1] ."%' " if ( @$filters[1] );
225 $strcalc .= " AND sort1 like ' " . @$filters[2] ."%'" if ( @$filters[2] );
226 $strcalc .= " AND sort2 like ' " . @$filters[3] ."%'" if ( @$filters[3] );
227 $strcalc .= " AND zipcode like ' " . @$filters[4] ."%'" if ( @$filters[4] );
228 $strcalc .= " and $status='1' " if ($status);
230 my $dbcalc = $dbh->prepare($strcalc);
235 for (my $i=0; $i<=$#looprow; $i++) {
236 my $row = $looprow[$i]->{'rowtitle'};
240 for (my $j=0;$j<=$#loopcol;$j++) {
241 my $col = $loopcol[$j]->{'coltitle'};
242 $dbcalc->execute($row,$col);
243 my ($value) = $dbcalc->fetchrow;
244 # warn "$row / $col / $value";
246 $grantotal += $value;
247 $loopfooter[$j]->{'totalcol'} +=$value;
248 push @loopcell,{value => $value};
250 $looprow[$i]->{'totalrow'}=$totalrow;
251 $looprow[$i]->{'loopcell'}=\@loopcell;
252 $looprow[$i]->{'hilighted'} = 1 if $hilighted eq 1;
253 $hilighted = -$hilighted;
256 # # the header of the table
257 $globalline{loopfilter}=\@loopfilter;
258 $globalline{looprow} = \@looprow;
259 # # the core of the table
260 $globalline{loopcol} = \@loopcol;
261 # # the foot (totals by borrower type)
262 $globalline{loopfooter} = \@loopfooter;
263 $globalline{total}= $grantotal;
264 $globalline{line} = $line;
265 $globalline{column} = $column;
266 push @mainloop,\%globalline;