3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21 #use warnings; FIXME - Bug 2505
34 use Koha
::Patron
::Categories
;
38 plugin that shows a stats on borrowers
45 $debug and open DEBUG
, ">/tmp/bor_issues_top.debug.log";
48 my $fullreportname = "reports/bor_issues_top.tt";
49 my $do_it = $input->param('do_it');
50 my $limit = $input->param("Limit");
51 my $column = $input->param("Criteria");
52 my @filters = $input->multi_param("Filter");
53 foreach ( @filters[0..3] ) {
54 $_ and $_ = eval { output_pref
( { dt
=> dt_from_string
( $_ ), dateonly
=> 1, dateformat
=> 'iso' }); };
56 my $output = $input->param("output");
57 my $basename = $input->param("basename");
58 my ($template, $borrowernumber, $cookie)
59 = get_template_and_user
({template_name
=> $fullreportname,
63 flagsrequired
=> {reports
=> '*'},
66 our $sep = $input->param("sep");
67 $sep = "\t" if ($sep eq 'tabulation');
68 $template->param(do_it
=> $do_it,
72 my $results = calculate
($limit, $column, \
@filters);
73 if ($output eq "screen"){
74 # Printing results to screen
75 $template->param(mainloop
=> $results, limit
=>$limit);
76 output_html_with_http_headers
$input, $cookie, $template->output;
78 # Printing to a csv file
79 print $input->header(-type
=> 'application/vnd.sun.xml.calc',
81 -attachment
=>"$basename.csv",
82 -filename
=>"$basename.csv" );
83 my $cols = @
$results[0]->{loopcol
};
84 my $lines = @
$results[0]->{looprow
};
86 print @
$results[0]->{line
} ."/". @
$results[0]->{column
} .$sep;
88 print join($sep, map {$_->{coltitle
}} @
$cols);
89 print $sep . "Total\n";
91 foreach my $line ( @
$lines ) {
92 my $x = $line->{loopcell
};
93 print $line->{rowtitle
}.$sep;
94 print join($sep, map {$_->{value
}} @
$x);
95 print $sep,$line->{totalrow
};
100 $cols = @
$results[0]->{loopfooter
};
101 print join($sep, map {$_->{totalcol
}} @
$cols);
102 print $sep.@
$results[0]->{total
};
107 my $dbh = C4
::Context
->dbh;
110 # here each element returned by map is a hashref, get it?
111 my @mime = ( map { {type
=>$_} } (split /[;:]/, 'CSV') ); # FIXME translation
112 my $delims = GetDelimiterChoices
;
114 my $patron_categories = Koha
::Patron
::Categories
->search_limited({}, {order_by
=> ['categorycode']});
115 my $itemtypes = Koha
::ItemTypes
->search_with_localization;
118 CGIseplist
=> $delims,
119 itemtypes
=> $itemtypes,
120 patron_categories
=> $patron_categories,
122 output_html_with_http_headers
$input, $cookie, $template->output;
126 my ($limit, $column, $filters) = @_;
134 my $dbh = C4
::Context
->dbh;
151 for (my $i=0;$i<=6;$i++) {
153 if ( @
$filters[$i] ) {
154 if (($i==1) and (@
$filters[$i-1])) {
155 $cell{err
} = 1 if (@
$filters[$i]<@
$filters[$i-1]) ;
157 # format the dates filters, otherwise just fill as is
158 $cell{filter
} .= @
$filters[$i];
159 defined ($cellmap[$i]) and
160 $cell{crit
} .= $cellmap[$i];
161 push @loopfilter, \
%cell;
167 $column = "old_issues." .$column if (($column=~/branchcode/) or ($column=~/timestamp/));
168 $column = "biblioitems.".$column if $column=~/itemtype/;
169 $column = "borrowers." .$column if $column=~/categorycode/;
171 if ($column =~ /timestamp/) {
172 $colfilter[0] = @
$filters[0];
173 $colfilter[1] = @
$filters[1];
174 } elsif ($column =~ /returndate/) {
175 $colfilter[0] = @
$filters[2];
176 $colfilter[1] = @
$filters[3];
177 } elsif ($column =~ /branchcode/) {
178 $colfilter[0] = @
$filters[4];
179 } elsif ($column =~ /itemtype/) {
180 $colfilter[0] = @
$filters[5];
181 } elsif ($column =~ /category/) {
182 $colfilter[0] = @
$filters[6];
183 } elsif ($column =~ /sort2/ ) {
184 # $colfilter[0] = @$filters[11];
188 if ($column eq "Day") {
190 $column = "old_issues.timestamp";
191 $colfield .="dayname($column)";
192 $colorder .="weekday($column)";
193 } elsif ($column eq "Month") {
195 $column = "old_issues.timestamp";
196 $colfield .="monthname($column)";
197 $colorder .="month($column)";
198 } elsif ($column eq "Year") {
200 $column = "old_issues.timestamp";
201 $colfield .="Year($column)";
202 $colorder .= $column;
204 $colfield .= $column;
205 $colorder .= $column;
209 $strsth2 .= "SELECT DISTINCTROW $colfield
211 LEFT JOIN borrowers ON old_issues.borrowernumber=borrowers.borrowernumber
212 LEFT JOIN items ON old_issues.itemnumber=items.itemnumber
213 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
215 if (($column=~/timestamp/) or ($column=~/returndate/)){
216 if ($colfilter[1] and $colfilter[0]){
217 $strsth2 .= " AND $column between '$colfilter[0]' AND '$colfilter[1]' " ;
218 } elsif ($colfilter[1]) {
219 $strsth2 .= " AND $column < '$colfilter[1]' " ;
220 } elsif ($colfilter[0]) {
221 $strsth2 .= " AND $column > '$colfilter[0]' " ;
223 } elsif ($colfilter[0]) {
224 $colfilter[0] =~ s/\*/%/g;
225 $strsth2 .= " AND $column LIKE '$colfilter[0]' " ;
227 $strsth2 .=" GROUP BY $colfield";
228 $strsth2 .=" ORDER BY $colorder";
230 $debug and print DEBUG
"bor_issues_top (old_issues) SQL: $strsth2\n";
231 my $sth2 = $dbh->prepare($strsth2);
233 print DEBUG
"rows: ", $sth2->rows, "\n";
234 while (my @row = $sth2->fetchrow) {
235 $columns{($row[0] ||'NULL')}++;
236 push @loopcol, { coltitle
=> $row[0] || 'NULL' };
239 $strsth2 =~ s/old_issues/issues/g;
240 $debug and print DEBUG
"bor_issues_top (issues) SQL: $strsth2\n";
241 $sth2 = $dbh->prepare($strsth2);
243 $debug and print DEBUG
"rows: ", $sth2->rows, "\n";
244 while (my @row = $sth2->fetchrow) {
245 $columns{($row[0] ||'NULL')}++;
246 push @loopcol, { coltitle
=> $row[0] || 'NULL' };
248 $debug and print DEBUG
"full array: ", Dumper
(\
%columns), "\n";
255 # Processing average loanperiods
256 $strcalc .= "SELECT CONCAT_WS('', borrowers.surname , \",\\t\", borrowers.firstname), COUNT(*) AS RANK, borrowers.borrowernumber AS ID";
257 $strcalc .= " , $colfield " if ($colfield);
258 $strcalc .= " FROM `old_issues`
259 LEFT JOIN borrowers USING(borrowernumber)
260 LEFT JOIN items USING(itemnumber)
261 LEFT JOIN biblioitems USING(biblioitemnumber)
262 WHERE old_issues.borrowernumber IS NOT NULL
265 'old_issues.issuedate >',
266 'old_issues.issuedate <',
267 'old_issues.returndate >',
268 'old_issues.returndate <',
269 'old_issues.branchcode like',
270 'biblioitems.itemtype like',
271 'borrowers.categorycode like',
273 foreach ((@
$filters)[0..9]) {
274 my $term = shift @filterterms; # go through both arrays in step
277 $strcalc .= " AND $term '$_' ";
279 $strcalc .= " GROUP BY borrowers.borrowernumber";
280 $strcalc .= ", $colfield" if ($column);
281 $strcalc .= " ORDER BY RANK DESC";
282 $strcalc .= ",$colfield " if ($colfield);
283 $strcalc .= " LIMIT $limit" if ($limit);
285 $debug and print DEBUG
"(old_issues) SQL : $strcalc\n";
286 my $dbcalc = $dbh->prepare($strcalc);
288 $debug and print DEBUG
"rows: ", $dbcalc->rows, "\n";
290 # DATA STRUCTURE is going to look like this:
291 # (2253=> {name=>"John Doe",
292 # allcols=>{MAIN=>12, MEDIA_LIB=>3}
295 while (my @data = $dbcalc->fetchrow) {
296 my ($row, $rank, $id, $col) = @data;
297 $col = "zzEMPTY" if (!defined($col));
298 unless ($patrons{$id}) {
299 $patrons{$id} = {name
=>$row, allcols
=>{}, newcols
=>{}, oldcols
=>{}};
301 $patrons{$id}->{oldcols
}->{$col} = $rank;
306 $strcalc =~ s/old_issues/issues/g;
307 $debug and print DEBUG
"(issues) SQL : $strcalc\n";
308 $dbcalc = $dbh->prepare($strcalc);
310 $debug and print DEBUG
"rows: ", $dbcalc->rows, "\n";
311 while (my @data = $dbcalc->fetchrow) {
312 my ($row, $rank, $id, $col) = @data;
313 $col = "zzEMPTY" if (!defined($col));
314 unless ($patrons{$id}) {
315 $patrons{$id} = {name
=>$row, allcols
=>{}, newcols
=>{}, oldcols
=>{}};
317 $patrons{$id}->{newcols
}->{$col} = $rank;
320 foreach my $id (keys %patrons) {
321 my @uniq = keys %{{ %{$patrons{$id}->{newcols
}}, %{$patrons{$id}->{oldcols
}} }}; # get uniq keys, see perlfaq4
323 my $count = ($patrons{$id}->{newcols
}->{$_} || 0) +
324 ($patrons{$id}->{oldcols
}->{$_} || 0);
325 $patrons{$id}->{allcols
}->{$_} = $count;
326 $patrons{$id}->{total
} += $count;
329 $debug and print DEBUG
"\n\npatrons: ", Dumper
(\
%patrons);
332 my @cols_in_order = sort keys %columns; # if you want to order the columns, do something here
333 my @ranked_ids = sort {
334 $patrons{$b}->{total
} <=> $patrons{$a}->{total
}
335 || $patrons{$a}->{name
} cmp $patrons{$b}->{name
}
337 foreach my $id (@ranked_ids) {
340 foreach my $key (@cols_in_order) {
343 value
=> $patrons{$id}->{name
},
345 count
=> $patrons{$id}->{allcols
}->{$key},
349 value
=> $patrons{$id}->{name
},
351 count
=> $patrons{$id}->{total
},
355 push @looprow,{ 'rowtitle' => $i++ ,
356 'loopcell' => \
@loopcell,
357 'hilighted' => ($i%2),
359 # use a limit, if a limit is defined
360 last if $i > $limit and $limit
363 # the header of the table
364 $globalline{loopfilter
}=\
@loopfilter;
365 # the core of the table
366 $globalline{looprow
} = \
@looprow;
367 $globalline{loopcol
} = [ map {{coltitle
=>$_}} @cols_in_order ];
368 # the foot (totals by borrower type)
369 $globalline{loopfooter
} = [];
370 $globalline{total
}= $grantotal; # FIXME: useless
371 $globalline{column
} = $column;
372 return [\
%globalline]; # reference to a 1 element array: that element is a hashref
375 $debug and close DEBUG
;