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
36 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->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 ($codes,$labels) = GetborCatFromCatType(undef,undef);
135 foreach (sort keys %$labels) {
136 my %row =(value => $_,
137 description => $labels->{$_},
139 push @borcatloop, \%row;
144 CGIseplist => $delims,
145 branchloop => \@branchloop,
146 itemtypeloop => \@itemtypeloop,
147 borcatloop => \@borcatloop,
149 output_html_with_http_headers $input, $cookie, $template->output;
153 my ($limit, $column, $filters) = @_;
161 my $dbh = C4::Context->dbh;
178 for (my $i=0;$i<=6;$i++) {
180 if ( @$filters[$i] ) {
181 if (($i==1) and (@$filters[$i-1])) {
182 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
184 # format the dates filters, otherwise just fill as is
185 $cell{filter} .= @$filters[$i];
186 defined ($cellmap[$i]) and
187 $cell{crit} .= $cellmap[$i];
188 push @loopfilter, \%cell;
194 $column = "old_issues." .$column if (($column=~/branchcode/) or ($column=~/timestamp/));
195 $column = "biblioitems.".$column if $column=~/itemtype/;
196 $column = "borrowers." .$column if $column=~/categorycode/;
198 if ($column =~ /timestamp/) {
199 $colfilter[0] = @$filters[0];
200 $colfilter[1] = @$filters[1];
201 } elsif ($column =~ /returndate/) {
202 $colfilter[0] = @$filters[2];
203 $colfilter[1] = @$filters[3];
204 } elsif ($column =~ /branchcode/) {
205 $colfilter[0] = @$filters[4];
206 } elsif ($column =~ /itemtype/) {
207 $colfilter[0] = @$filters[5];
208 } elsif ($column =~ /category/) {
209 $colfilter[0] = @$filters[6];
210 } elsif ($column =~ /sort2/ ) {
211 # $colfilter[0] = @$filters[11];
215 if ($column eq "Day") {
217 $column = "old_issues.timestamp";
218 $colfield .="dayname($column)";
219 $colorder .="weekday($column)";
220 } elsif ($column eq "Month") {
222 $column = "old_issues.timestamp";
223 $colfield .="monthname($column)";
224 $colorder .="month($column)";
225 } elsif ($column eq "Year") {
227 $column = "old_issues.timestamp";
228 $colfield .="Year($column)";
229 $colorder .= $column;
231 $colfield .= $column;
232 $colorder .= $column;
236 $strsth2 .= "SELECT DISTINCTROW $colfield
238 LEFT JOIN borrowers ON old_issues.borrowernumber=borrowers.borrowernumber
239 LEFT JOIN items ON old_issues.itemnumber=items.itemnumber
240 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
242 if (($column=~/timestamp/) or ($column=~/returndate/)){
243 if ($colfilter[1] and $colfilter[0]){
244 $strsth2 .= " AND $column between '$colfilter[0]' AND '$colfilter[1]' " ;
245 } elsif ($colfilter[1]) {
246 $strsth2 .= " AND $column < '$colfilter[1]' " ;
247 } elsif ($colfilter[0]) {
248 $strsth2 .= " AND $column > '$colfilter[0]' " ;
250 } elsif ($colfilter[0]) {
251 $colfilter[0] =~ s/\*/%/g;
252 $strsth2 .= " AND $column LIKE '$colfilter[0]' " ;
254 $strsth2 .=" GROUP BY $colfield";
255 $strsth2 .=" ORDER BY $colorder";
257 $debug and print DEBUG "bor_issues_top (old_issues) SQL: $strsth2\n";
258 my $sth2 = $dbh->prepare($strsth2);
260 print DEBUG "rows: ", $sth2->rows, "\n";
261 while (my @row = $sth2->fetchrow) {
262 $columns{($row[0] ||'NULL')}++;
263 push @loopcol, { coltitle => $row[0] || 'NULL' };
266 $strsth2 =~ s/old_issues/issues/g;
267 $debug and print DEBUG "bor_issues_top (issues) SQL: $strsth2\n";
268 $sth2 = $dbh->prepare($strsth2);
270 $debug and print DEBUG "rows: ", $sth2->rows, "\n";
271 while (my @row = $sth2->fetchrow) {
272 $columns{($row[0] ||'NULL')}++;
273 push @loopcol, { coltitle => $row[0] || 'NULL' };
275 $debug and print DEBUG "full array: ", Dumper(\%columns), "\n";
282 # Processing average loanperiods
283 $strcalc .= "SELECT CONCAT_WS('', borrowers.surname , \",\\t\", borrowers.firstname), COUNT(*) AS RANK, borrowers.borrowernumber AS ID";
284 $strcalc .= " , $colfield " if ($colfield);
285 $strcalc .= " FROM `old_issues`
286 LEFT JOIN borrowers USING(borrowernumber)
287 LEFT JOIN items USING(itemnumber)
288 LEFT JOIN biblioitems USING(biblioitemnumber)
289 WHERE old_issues.borrowernumber IS NOT NULL
292 'old_issues.issuedate >',
293 'old_issues.issuedate <',
294 'old_issues.returndate >',
295 'old_issues.returndate <',
296 'old_issues.branchcode like',
297 'biblioitems.itemtype like',
298 'borrowers.categorycode like',
300 foreach ((@$filters)[0..9]) {
301 my $term = shift @filterterms; # go through both arrays in step
304 $strcalc .= " AND $term '$_' ";
306 $strcalc .= " GROUP BY borrowers.borrowernumber";
307 $strcalc .= ", $colfield" if ($column);
308 $strcalc .= " ORDER BY RANK DESC";
309 $strcalc .= ",$colfield " if ($colfield);
310 $strcalc .= " LIMIT $limit" if ($limit);
312 $debug and print DEBUG "(old_issues) SQL : $strcalc\n";
313 my $dbcalc = $dbh->prepare($strcalc);
315 $debug and print DEBUG "rows: ", $dbcalc->rows, "\n";
317 # DATA STRUCTURE is going to look like this:
318 # (2253=> {name=>"John Doe",
319 # allcols=>{MAIN=>12, MEDIA_LIB=>3}
322 while (my @data = $dbcalc->fetchrow) {
323 my ($row, $rank, $id, $col) = @data;
324 $col = "zzEMPTY" if (!defined($col));
325 unless ($patrons{$id}) {
326 $patrons{$id} = {name=>$row, allcols=>{}, newcols=>{}, oldcols=>{}};
328 $patrons{$id}->{oldcols}->{$col} = $rank;
333 $strcalc =~ s/old_issues/issues/g;
334 $debug and print DEBUG "(issues) SQL : $strcalc\n";
335 $dbcalc = $dbh->prepare($strcalc);
337 $debug and print DEBUG "rows: ", $dbcalc->rows, "\n";
338 while (my @data = $dbcalc->fetchrow) {
339 my ($row, $rank, $id, $col) = @data;
340 $col = "zzEMPTY" if (!defined($col));
341 unless ($patrons{$id}) {
342 $patrons{$id} = {name=>$row, allcols=>{}, newcols=>{}, oldcols=>{}};
344 $patrons{$id}->{newcols}->{$col} = $rank;
347 foreach my $id (keys %patrons) {
348 my @uniq = keys %{{ %{$patrons{$id}->{newcols}}, %{$patrons{$id}->{oldcols}} }}; # get uniq keys, see perlfaq4
350 my $count = ($patrons{$id}->{newcols}->{$_} || 0) +
351 ($patrons{$id}->{oldcols}->{$_} || 0);
352 $patrons{$id}->{allcols}->{$_} = $count;
353 $patrons{$id}->{total} += $count;
356 $debug and print DEBUG "\n\npatrons: ", Dumper(\%patrons);
359 my @cols_in_order = sort keys %columns; # if you want to order the columns, do something here
360 my @ranked_ids = sort {
361 $patrons{$b}->{total} <=> $patrons{$a}->{total}
362 || $patrons{$a}->{name} cmp $patrons{$b}->{name}
364 foreach my $id (@ranked_ids) {
367 foreach my $key (@cols_in_order) {
370 value => $patrons{$id}->{name},
372 count => $patrons{$id}->{allcols}->{$key},
376 value => $patrons{$id}->{name},
378 count => $patrons{$id}->{total},
382 push @looprow,{ 'rowtitle' => $i++ ,
383 'loopcell' => \@loopcell,
384 'hilighted' => ($i%2),
386 # use a limit, if a limit is defined
387 last if $i > $limit and $limit
390 # the header of the table
391 $globalline{loopfilter}=\@loopfilter;
392 # the core of the table
393 $globalline{looprow} = \@looprow;
394 $globalline{loopcol} = [ map {{coltitle=>$_}} @cols_in_order ];
395 # the foot (totals by borrower type)
396 $globalline{loopfooter} = [];
397 $globalline{total}= $grantotal; # FIXME: useless
398 $globalline{column} = $column;
399 return [\%globalline]; # reference to a 1 element array: that element is a hashref
402 $debug and close DEBUG;