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
26 use C4
::Branch
; # GetBranches
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
;
113 my $branches = GetBranches
;
115 foreach (sort keys %$branches) {
116 # my $selected = 1 if $thisbranch eq $branch;
117 my %row = ( value
=> $_,
118 # selected => $selected,
119 branchname
=> $branches->{$_}->{branchname
},
121 push @branchloop, \
%row;
124 my $itemtypes = GetItemTypes
;
126 foreach (sort {$itemtypes->{$a}->{translated_description
} cmp $itemtypes->{$b}->{translated_description
}} keys %$itemtypes) {
127 my %row = (value
=> $_,
128 translated_description
=> $itemtypes->{$_}->{translated_description
},
130 push @itemtypeloop, \
%row;
133 my $patron_categories = Koha
::Patron
::Categories
->search_limited({}, {order_by
=> ['categorycode']});
137 CGIseplist
=> $delims,
138 branchloop
=> \
@branchloop,
139 itemtypeloop
=> \
@itemtypeloop,
140 patron_categories
=> $patron_categories,
142 output_html_with_http_headers
$input, $cookie, $template->output;
146 my ($limit, $column, $filters) = @_;
154 my $dbh = C4
::Context
->dbh;
171 for (my $i=0;$i<=6;$i++) {
173 if ( @
$filters[$i] ) {
174 if (($i==1) and (@
$filters[$i-1])) {
175 $cell{err
} = 1 if (@
$filters[$i]<@
$filters[$i-1]) ;
177 # format the dates filters, otherwise just fill as is
178 $cell{filter
} .= @
$filters[$i];
179 defined ($cellmap[$i]) and
180 $cell{crit
} .= $cellmap[$i];
181 push @loopfilter, \
%cell;
187 $column = "old_issues." .$column if (($column=~/branchcode/) or ($column=~/timestamp/));
188 $column = "biblioitems.".$column if $column=~/itemtype/;
189 $column = "borrowers." .$column if $column=~/categorycode/;
191 if ($column =~ /timestamp/) {
192 $colfilter[0] = @
$filters[0];
193 $colfilter[1] = @
$filters[1];
194 } elsif ($column =~ /returndate/) {
195 $colfilter[0] = @
$filters[2];
196 $colfilter[1] = @
$filters[3];
197 } elsif ($column =~ /branchcode/) {
198 $colfilter[0] = @
$filters[4];
199 } elsif ($column =~ /itemtype/) {
200 $colfilter[0] = @
$filters[5];
201 } elsif ($column =~ /category/) {
202 $colfilter[0] = @
$filters[6];
203 } elsif ($column =~ /sort2/ ) {
204 # $colfilter[0] = @$filters[11];
208 if ($column eq "Day") {
210 $column = "old_issues.timestamp";
211 $colfield .="dayname($column)";
212 $colorder .="weekday($column)";
213 } elsif ($column eq "Month") {
215 $column = "old_issues.timestamp";
216 $colfield .="monthname($column)";
217 $colorder .="month($column)";
218 } elsif ($column eq "Year") {
220 $column = "old_issues.timestamp";
221 $colfield .="Year($column)";
222 $colorder .= $column;
224 $colfield .= $column;
225 $colorder .= $column;
229 $strsth2 .= "SELECT DISTINCTROW $colfield
231 LEFT JOIN borrowers ON old_issues.borrowernumber=borrowers.borrowernumber
232 LEFT JOIN items ON old_issues.itemnumber=items.itemnumber
233 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
235 if (($column=~/timestamp/) or ($column=~/returndate/)){
236 if ($colfilter[1] and $colfilter[0]){
237 $strsth2 .= " AND $column between '$colfilter[0]' AND '$colfilter[1]' " ;
238 } elsif ($colfilter[1]) {
239 $strsth2 .= " AND $column < '$colfilter[1]' " ;
240 } elsif ($colfilter[0]) {
241 $strsth2 .= " AND $column > '$colfilter[0]' " ;
243 } elsif ($colfilter[0]) {
244 $colfilter[0] =~ s/\*/%/g;
245 $strsth2 .= " AND $column LIKE '$colfilter[0]' " ;
247 $strsth2 .=" GROUP BY $colfield";
248 $strsth2 .=" ORDER BY $colorder";
250 $debug and print DEBUG
"bor_issues_top (old_issues) SQL: $strsth2\n";
251 my $sth2 = $dbh->prepare($strsth2);
253 print DEBUG
"rows: ", $sth2->rows, "\n";
254 while (my @row = $sth2->fetchrow) {
255 $columns{($row[0] ||'NULL')}++;
256 push @loopcol, { coltitle
=> $row[0] || 'NULL' };
259 $strsth2 =~ s/old_issues/issues/g;
260 $debug and print DEBUG
"bor_issues_top (issues) SQL: $strsth2\n";
261 $sth2 = $dbh->prepare($strsth2);
263 $debug and print DEBUG
"rows: ", $sth2->rows, "\n";
264 while (my @row = $sth2->fetchrow) {
265 $columns{($row[0] ||'NULL')}++;
266 push @loopcol, { coltitle
=> $row[0] || 'NULL' };
268 $debug and print DEBUG
"full array: ", Dumper
(\
%columns), "\n";
275 # Processing average loanperiods
276 $strcalc .= "SELECT CONCAT_WS('', borrowers.surname , \",\\t\", borrowers.firstname), COUNT(*) AS RANK, borrowers.borrowernumber AS ID";
277 $strcalc .= " , $colfield " if ($colfield);
278 $strcalc .= " FROM `old_issues`
279 LEFT JOIN borrowers USING(borrowernumber)
280 LEFT JOIN items USING(itemnumber)
281 LEFT JOIN biblioitems USING(biblioitemnumber)
282 WHERE old_issues.borrowernumber IS NOT NULL
285 'old_issues.issuedate >',
286 'old_issues.issuedate <',
287 'old_issues.returndate >',
288 'old_issues.returndate <',
289 'old_issues.branchcode like',
290 'biblioitems.itemtype like',
291 'borrowers.categorycode like',
293 foreach ((@
$filters)[0..9]) {
294 my $term = shift @filterterms; # go through both arrays in step
297 $strcalc .= " AND $term '$_' ";
299 $strcalc .= " GROUP BY borrowers.borrowernumber";
300 $strcalc .= ", $colfield" if ($column);
301 $strcalc .= " ORDER BY RANK DESC";
302 $strcalc .= ",$colfield " if ($colfield);
303 $strcalc .= " LIMIT $limit" if ($limit);
305 $debug and print DEBUG
"(old_issues) SQL : $strcalc\n";
306 my $dbcalc = $dbh->prepare($strcalc);
308 $debug and print DEBUG
"rows: ", $dbcalc->rows, "\n";
310 # DATA STRUCTURE is going to look like this:
311 # (2253=> {name=>"John Doe",
312 # allcols=>{MAIN=>12, MEDIA_LIB=>3}
315 while (my @data = $dbcalc->fetchrow) {
316 my ($row, $rank, $id, $col) = @data;
317 $col = "zzEMPTY" if (!defined($col));
318 unless ($patrons{$id}) {
319 $patrons{$id} = {name
=>$row, allcols
=>{}, newcols
=>{}, oldcols
=>{}};
321 $patrons{$id}->{oldcols
}->{$col} = $rank;
326 $strcalc =~ s/old_issues/issues/g;
327 $debug and print DEBUG
"(issues) SQL : $strcalc\n";
328 $dbcalc = $dbh->prepare($strcalc);
330 $debug and print DEBUG
"rows: ", $dbcalc->rows, "\n";
331 while (my @data = $dbcalc->fetchrow) {
332 my ($row, $rank, $id, $col) = @data;
333 $col = "zzEMPTY" if (!defined($col));
334 unless ($patrons{$id}) {
335 $patrons{$id} = {name
=>$row, allcols
=>{}, newcols
=>{}, oldcols
=>{}};
337 $patrons{$id}->{newcols
}->{$col} = $rank;
340 foreach my $id (keys %patrons) {
341 my @uniq = keys %{{ %{$patrons{$id}->{newcols
}}, %{$patrons{$id}->{oldcols
}} }}; # get uniq keys, see perlfaq4
343 my $count = ($patrons{$id}->{newcols
}->{$_} || 0) +
344 ($patrons{$id}->{oldcols
}->{$_} || 0);
345 $patrons{$id}->{allcols
}->{$_} = $count;
346 $patrons{$id}->{total
} += $count;
349 $debug and print DEBUG
"\n\npatrons: ", Dumper
(\
%patrons);
352 my @cols_in_order = sort keys %columns; # if you want to order the columns, do something here
353 my @ranked_ids = sort {
354 $patrons{$b}->{total
} <=> $patrons{$a}->{total
}
355 || $patrons{$a}->{name
} cmp $patrons{$b}->{name
}
357 foreach my $id (@ranked_ids) {
360 foreach my $key (@cols_in_order) {
363 value
=> $patrons{$id}->{name
},
365 count
=> $patrons{$id}->{allcols
}->{$key},
369 value
=> $patrons{$id}->{name
},
371 count
=> $patrons{$id}->{total
},
375 push @looprow,{ 'rowtitle' => $i++ ,
376 'loopcell' => \
@loopcell,
377 'hilighted' => ($i%2),
379 # use a limit, if a limit is defined
380 last if $i > $limit and $limit
383 # the header of the table
384 $globalline{loopfilter
}=\
@loopfilter;
385 # the core of the table
386 $globalline{looprow
} = \
@looprow;
387 $globalline{loopcol
} = [ map {{coltitle
=>$_}} @cols_in_order ];
388 # the foot (totals by borrower type)
389 $globalline{loopfooter
} = [];
390 $globalline{total
}= $grantotal; # FIXME: useless
391 $globalline{column
} = $column;
392 return [\
%globalline]; # reference to a 1 element array: that element is a hashref
395 $debug and close DEBUG
;