Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 430 lines (394 sloc) 14.18 kb
a0b06fb @ctfliblime Prepare for perlbrew usage by changing all script magic to "#!/usr/bi…
ctfliblime authored
1 #!/usr/bin/env perl
4bf980d Fixes on issues_avg_stats
hdl authored
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
19
20 use strict;
21 use CGI;
100e6a9 functions that were in C4::Interface::CGI::Output are now in C4::Output.
hdl authored
22 use C4::Auth;
23 use C4::Output;
3607caa @ctfliblime Add Koha.pm and include it universally
ctfliblime authored
24 use Koha;
4bf980d Fixes on issues_avg_stats
hdl authored
25 use C4::Context;
fc1342f rel_3_0 moved to HEAD
tipaul authored
26 use C4::Branch; # GetBranches
4bf980d Fixes on issues_avg_stats
hdl authored
27 use C4::Koha;
c596d55 HUGE COMMIT : code cleaning circulation.
tipaul authored
28 use C4::Circulation;
fc1342f rel_3_0 moved to HEAD
tipaul authored
29 use C4::Members;
b8d8a0e fix for bug 2543: report output by tabulation a bit too literal
Jesse Weaver authored
30 use C4::Reports;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
31 use C4::Debug;
ddb65c4 cleanup of reports/ Dates - missing format_date, etc.
Joshua Ferraro authored
32 use C4::Dates qw(format_date format_date_in_iso);
4bf980d Fixes on issues_avg_stats
hdl authored
33
34 =head1 NAME
35
36 plugin that shows a stats on borrowers
37
38 =head1 DESCRIPTION
39
4af7e13 Cleaning up perldocs for make utility that MJ wrote. I was getting a …
kados authored
40 =over 2
4bf980d Fixes on issues_avg_stats
hdl authored
41
42 =cut
43
3738647 @pianohacker Allow multiple values to be selected for criteria in canned reports
pianohacker authored
44 $debug = 0;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
45 $debug and open DEBUG, ">/tmp/bor_issues_top.debug.log";
46
4bf980d Fixes on issues_avg_stats
hdl authored
47 my $input = new CGI;
48 my $fullreportname = "reports/bor_issues_top.tmpl";
63dd923 reports subdir - Dates.pm integration and warnings fixes.
Joe Atzberger authored
49 my $do_it = $input->param('do_it');
50 my $limit = $input->param("Limit");
51 my $column = $input->param("Criteria");
4bf980d Fixes on issues_avg_stats
hdl authored
52 my @filters = $input->param("Filter");
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
53 foreach ( @filters[0..3] ) {
54 $_ and $_ = format_date_in_iso($_);
63dd923 reports subdir - Dates.pm integration and warnings fixes.
Joe Atzberger authored
55 }
56 my $output = $input->param("output");
4bf980d Fixes on issues_avg_stats
hdl authored
57 my $basename = $input->param("basename");
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
58 # my $mime = $input->param("MIME");
4bf980d Fixes on issues_avg_stats
hdl authored
59 my ($template, $borrowernumber, $cookie)
a5bd240 FIX for Date calculation
paul authored
60 = get_template_and_user({template_name => $fullreportname,
61 query => $input,
62 type => "intranet",
63 authnotrequired => 0,
64 flagsrequired => {reports => 1},
65 debug => 1,
66 });
b8d8a0e fix for bug 2543: report output by tabulation a bit too literal
Jesse Weaver authored
67 our $sep = $input->param("sep");
68 $sep = "\t" if ($sep eq 'tabulation');
fc1342f rel_3_0 moved to HEAD
tipaul authored
69 $template->param(do_it => $do_it,
63dd923 reports subdir - Dates.pm integration and warnings fixes.
Joe Atzberger authored
70 DHTMLcalendar_dateformat => C4::Dates->DHTMLcalendar(),
a5bd240 FIX for Date calculation
paul authored
71 );
4bf980d Fixes on issues_avg_stats
hdl authored
72 if ($do_it) {
73 # Displaying results
a5bd240 FIX for Date calculation
paul authored
74 my $results = calculate($limit, $column, \@filters);
75 if ($output eq "screen"){
4bf980d Fixes on issues_avg_stats
hdl authored
76 # Printing results to screen
a5bd240 FIX for Date calculation
paul authored
77 $template->param(mainloop => $results, limit=>$limit);
78 output_html_with_http_headers $input, $cookie, $template->output;
79 } else {
4bf980d Fixes on issues_avg_stats
hdl authored
80 # Printing to a csv file
a5bd240 FIX for Date calculation
paul authored
81 print $input->header(-type => 'application/vnd.sun.xml.calc',
82 -encoding => 'utf-8',
83 -attachment=>"$basename.csv",
84 -filename=>"$basename.csv" );
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
85 my $cols = @$results[0]->{loopcol};
a5bd240 FIX for Date calculation
paul authored
86 my $lines = @$results[0]->{looprow};
4bf980d Fixes on issues_avg_stats
hdl authored
87 # header top-right
a5bd240 FIX for Date calculation
paul authored
88 print @$results[0]->{line} ."/". @$results[0]->{column} .$sep;
4bf980d Fixes on issues_avg_stats
hdl authored
89 # Other header
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
90 print join($sep, map {$_->{coltitle}} @$cols);
91 print $sep . "Total\n";
4bf980d Fixes on issues_avg_stats
hdl authored
92 # Table
a5bd240 FIX for Date calculation
paul authored
93 foreach my $line ( @$lines ) {
94 my $x = $line->{loopcell};
95 print $line->{rowtitle}.$sep;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
96 print join($sep, map {$_->{value}} @$x);
97 print $sep,$line->{totalrow};
a5bd240 FIX for Date calculation
paul authored
98 print "\n";
99 }
4bf980d Fixes on issues_avg_stats
hdl authored
100 # footer
a5bd240 FIX for Date calculation
paul authored
101 print "TOTAL";
102 $cols = @$results[0]->{loopfooter};
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
103 print join($sep, map {$_->{totalcol}} @$cols);
a5bd240 FIX for Date calculation
paul authored
104 print $sep.@$results[0]->{total};
105 }
326a2d9 @ctfliblime Update incorrect exit() calls in reports and labels
ctfliblime authored
106 exit;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
107 }
fc1342f rel_3_0 moved to HEAD
tipaul authored
108
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
109 my $dbh = C4::Context->dbh;
110 my @values;
111
112 # here each element returned by map is a hashref, get it?
113 my @mime = ( map { +{type =>$_} } (split /[;:]/,C4::Context->preference("MIME")) );
b8d8a0e fix for bug 2543: report output by tabulation a bit too literal
Jesse Weaver authored
114 my $delims = GetDelimiterChoices;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
115 my $branches = GetBranches;
116 my @branchloop;
9b4bda4 Resolve content and sort problems with report
J. David Bavousett authored
117 foreach (sort {$branches->{$a}->{branchname} cmp $branches->{$b}->{branchname}} keys %$branches) {
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
118 # my $selected = 1 if $thisbranch eq $branch;
119 my %row = ( value => $_,
120 # selected => $selected,
121 branchname => $branches->{$_}->{branchname},
122 );
123 push @branchloop, \%row;
124 }
125
126 my $itemtypes = GetItemTypes;
127 my @itemtypeloop;
128 foreach (sort {$itemtypes->{$a}->{description} cmp $itemtypes->{$b}->{description}} keys %$itemtypes) {
129 my %row = (value => $_,
130 description => $itemtypes->{$_}->{description},
131 );
132 push @itemtypeloop, \%row;
133 }
a5bd240 FIX for Date calculation
paul authored
134
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
135 my ($codes,$labels) = GetborCatFromCatType(undef,undef);
136 my @borcatloop;
137 foreach (sort keys %$labels) {
138 my %row =(value => $_,
139 description => $labels->{$_},
140 );
141 push @borcatloop, \%row;
142 }
a5bd240 FIX for Date calculation
paul authored
143
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
144 $template->param(
145 mimeloop => \@mime,
b8d8a0e fix for bug 2543: report output by tabulation a bit too literal
Jesse Weaver authored
146 CGIseplist => $delims,
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
147 branchloop => \@branchloop,
148 itemtypeloop => \@itemtypeloop,
149 borcatloop => \@borcatloop,
150 );
4bf980d Fixes on issues_avg_stats
hdl authored
151 output_html_with_http_headers $input, $cookie, $template->output;
152
153
154 sub calculate {
a5bd240 FIX for Date calculation
paul authored
155 my ($line, $column, $filters) = @_;
156 my @loopcol;
157 my @loopline;
158 my @looprow;
159 my %globalline;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
160 my %columns;
a5bd240 FIX for Date calculation
paul authored
161 my $grantotal =0;
162 my $dbh = C4::Context->dbh;
4bf980d Fixes on issues_avg_stats
hdl authored
163
164 # Checking filters
a5bd240 FIX for Date calculation
paul authored
165 my @loopfilter;
63dd923 reports subdir - Dates.pm integration and warnings fixes.
Joe Atzberger authored
166 my @cellmap = (
167 "Issue From",
168 "Issue To",
169 "Return From",
170 "Return To",
171 "Branch",
172 "Doc Type",
173 "Bor Cat",
174 "Day",
175 "Month",
176 "Year"
177 );
a5bd240 FIX for Date calculation
paul authored
178 for (my $i=0;$i<=6;$i++) {
179 my %cell;
180 if ( @$filters[$i] ) {
181 if (($i==1) and (@$filters[$i-1])) {
182 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
183 }
184 # format the dates filters, otherwise just fill as is
9b4bda4 Resolve content and sort problems with report
J. David Bavousett authored
185
186 if ($i<4){
187 $cell{filter} .= format_date(@filters[$i]);
188 }
189 elsif ($i==4){
190 $cell{filter} .= C4::Branch::GetBranchName(@$filters[$i]);
191 }
192 else {
193 $cell{filter} .= @$filters[$i];
194 }
195
63dd923 reports subdir - Dates.pm integration and warnings fixes.
Joe Atzberger authored
196 defined ($cellmap[$i]) and
197 $cell{crit} .= $cellmap[$i];
a5bd240 FIX for Date calculation
paul authored
198 push @loopfilter, \%cell;
199 }
200 }
201 my $colfield;
202 my $colorder;
203 if ($column){
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
204 $column = "old_issues." .$column if (($column=~/branchcode/) or ($column=~/timestamp/));
a5bd240 FIX for Date calculation
paul authored
205 $column = "biblioitems.".$column if $column=~/itemtype/;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
206 $column = "borrowers." .$column if $column=~/categorycode/;
a5bd240 FIX for Date calculation
paul authored
207 my @colfilter ;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
208 if ($column =~ /timestamp/) {
209 $colfilter[0] = @$filters[0];
210 $colfilter[1] = @$filters[1];
211 } elsif ($column =~ /returndate/) {
212 $colfilter[0] = @$filters[2];
213 $colfilter[1] = @$filters[3];
214 } elsif ($column =~ /branchcode/) {
215 $colfilter[0] = @$filters[4];
216 } elsif ($column =~ /itemtype/) {
217 $colfilter[0] = @$filters[5];
218 } elsif ($column =~ /category/) {
219 $colfilter[0] = @$filters[6];
220 } elsif ($column =~ /sort2/ ) {
221 # $colfilter[0] = @$filters[11];
222 }
223 # $colfilter[0] = @$filters[7] if ($column =~ /timestamp/ ) ; FIXME This can't be right.
224 # $colfilter[0] = @$filters[8] if ($column =~ /timestamp/ ) ; FIXME
225 # $colfilter[0] = @$filters[9] if ($column =~ /timestamp/ ) ; FIXME Only this line would have effect.
226
a5bd240 FIX for Date calculation
paul authored
227 #warn "filtre col ".$colfilter[0]." ".$colfilter[1];
228
229 # loop cols.
230 if ($column eq "Day") {
231 #Display by day
1bd019a borr_issues_top : adapting to old_issues changes
Henri-Damien LAURENT authored
232 $column = "old_issues.timestamp";
a5bd240 FIX for Date calculation
paul authored
233 $colfield .="dayname($column)";
234 $colorder .="weekday($column)";
235 } elsif ($column eq "Month") {
236 #Display by Month
1bd019a borr_issues_top : adapting to old_issues changes
Henri-Damien LAURENT authored
237 $column = "old_issues.timestamp";
a5bd240 FIX for Date calculation
paul authored
238 $colfield .="monthname($column)";
239 $colorder .="month($column)";
240 } elsif ($column eq "Year") {
241 #Display by Year
1bd019a borr_issues_top : adapting to old_issues changes
Henri-Damien LAURENT authored
242 $column = "old_issues.timestamp";
a5bd240 FIX for Date calculation
paul authored
243 $colfield .="Year($column)";
244 $colorder .= $column;
245 } else {
246 $colfield .= $column;
247 $colorder .= $column;
248 }
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
249
a5bd240 FIX for Date calculation
paul authored
250 my $strsth2;
ad76771 Bug Fix : 1898 Replaces the previous commit : More fixes.
Henri-Damien LAURENT authored
251 $strsth2 .= "SELECT DISTINCTROW $colfield
1bd019a borr_issues_top : adapting to old_issues changes
Henri-Damien LAURENT authored
252 FROM `old_issues`
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
253 LEFT JOIN borrowers ON old_issues.borrowernumber=borrowers.borrowernumber
254 LEFT JOIN items ON old_issues.itemnumber=items.itemnumber
ad76771 Bug Fix : 1898 Replaces the previous commit : More fixes.
Henri-Damien LAURENT authored
255 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
3eb7a60 more old_issues SQL cleanup
Galen Charlton authored
256 WHERE 1";
a5bd240 FIX for Date calculation
paul authored
257 if (($column=~/timestamp/) or ($column=~/returndate/)){
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
258 if ($colfilter[1] and $colfilter[0]){
3eb7a60 more old_issues SQL cleanup
Galen Charlton authored
259 $strsth2 .= " AND $column between '$colfilter[0]' AND '$colfilter[1]' " ;
a5bd240 FIX for Date calculation
paul authored
260 } elsif ($colfilter[1]) {
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
261 $strsth2 .= " AND $column < '$colfilter[1]' " ;
a5bd240 FIX for Date calculation
paul authored
262 } elsif ($colfilter[0]) {
3eb7a60 more old_issues SQL cleanup
Galen Charlton authored
263 $strsth2 .= " AND $column > '$colfilter[0]' " ;
a5bd240 FIX for Date calculation
paul authored
264 }
265 } elsif ($colfilter[0]) {
3738647 @pianohacker Allow multiple values to be selected for criteria in canned reports
pianohacker authored
266 $strsth2 = AddCondition( $strsth2, $column, $colfilter[0], 0 );
a5bd240 FIX for Date calculation
paul authored
267 }
3eb7a60 more old_issues SQL cleanup
Galen Charlton authored
268 $strsth2 .=" GROUP BY $colfield";
269 $strsth2 .=" ORDER BY $colorder";
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
270
271 $debug and print DEBUG "bor_issues_top (old_issues) SQL: $strsth2\n";
272 my $sth2 = $dbh->prepare($strsth2);
a5bd240 FIX for Date calculation
paul authored
273 $sth2->execute;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
274 print DEBUG "rows: ", $sth2->rows, "\n";
275 while (my @row = $sth2->fetchrow) {
276 $columns{($row[0] ||'NULL')}++;
277 push @loopcol, +{ coltitle => $row[0] || 'NULL' };
278 }
279
280 $strsth2 =~ s/old_issues/issues/g;
281 $debug and print DEBUG "bor_issues_top (issues) SQL: $strsth2\n";
282 $sth2 = $dbh->prepare($strsth2);
283 $sth2->execute;
284 $debug and print DEBUG "rows: ", $sth2->rows, "\n";
285 while (my @row = $sth2->fetchrow) {
286 $columns{($row[0] ||'NULL')}++;
287 push @loopcol, +{ coltitle => $row[0] || 'NULL' };
a5bd240 FIX for Date calculation
paul authored
288 }
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
289 $debug and print DEBUG "full array: ", Dumper(\%columns), "\n";
a5bd240 FIX for Date calculation
paul authored
290 }
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
291
a5bd240 FIX for Date calculation
paul authored
292 #Initialization of cell values.....
293 my @table;
294 for (my $i=1;$i<=$line;$i++) {
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
295 foreach (keys %columns) {
296 # warn " init table : $row->{rowtitle} / $_ ";
297 $table[$i]->{ $_ || "total" }->{'name'}=0;
a5bd240 FIX for Date calculation
paul authored
298 }
299 }
4bf980d Fixes on issues_avg_stats
hdl authored
300
a5bd240 FIX for Date calculation
paul authored
301 my $strcalc ;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
302
4bf980d Fixes on issues_avg_stats
hdl authored
303 # Processing average loanperiods
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
304 $strcalc .= "SELECT CONCAT(borrowers.surname , \",\\t\",borrowers.firstname), COUNT(*) AS RANK, borrowers.borrowernumber AS ID";
a5bd240 FIX for Date calculation
paul authored
305 $strcalc .= " , $colfield " if ($colfield);
1bd019a borr_issues_top : adapting to old_issues changes
Henri-Damien LAURENT authored
306 $strcalc .= " FROM `old_issues`
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
307 LEFT JOIN borrowers ON old_issues.borrowernumber=borrowers.borrowernumber
308 LEFT JOIN items ON items.itemnumber=old_issues.itemnumber
3eb7a60 more old_issues SQL cleanup
Galen Charlton authored
309 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
310 WHERE 1";
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
311 my @filterterms = (
312 'old_issues.timestamp >',
313 'old_issues.timestamp <',
314 'old_issues.returndate >',
315 'old_issues.returndate <',
3738647 @pianohacker Allow multiple values to be selected for criteria in canned reports
pianohacker authored
316 'old_issues.branchcode',
317 'biblioitems.itemtype',
318 'borrowers.categorycode',
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
319 'dayname(old_issues.timestamp) like',
320 'monthname(old_issues.timestamp) like',
321 'monthname(old_issues.timestamp) like',
322 'year(old_issues.timestamp) like',
323 );
3738647 @pianohacker Allow multiple values to be selected for criteria in canned reports
pianohacker authored
324 for ( my $i = 0; $i <= 9; $i++) {
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
325 my $term = shift @filterterms; # go through both arrays in step
3738647 @pianohacker Allow multiple values to be selected for criteria in canned reports
pianohacker authored
326 my $filter = shift @filters;
327 ($filter) or next;
328 if ( $i >= 4 && $i <= 6 ) {
329 $strcalc = AddCondition( $strcalc, $term, $filter, 0 );
330 } else {
9b4bda4 Resolve content and sort problems with report
J. David Bavousett authored
331 $strcalc .= " AND $term '$filter' ";
3738647 @pianohacker Allow multiple values to be selected for criteria in canned reports
pianohacker authored
332 }
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
333 }
a5bd240 FIX for Date calculation
paul authored
334
3eb7a60 more old_issues SQL cleanup
Galen Charlton authored
335 $strcalc .= " GROUP BY borrowers.borrowernumber";
a5bd240 FIX for Date calculation
paul authored
336 $strcalc .= ", $colfield" if ($column);
3eb7a60 more old_issues SQL cleanup
Galen Charlton authored
337 $strcalc .= " ORDER BY RANK DESC";
a5bd240 FIX for Date calculation
paul authored
338 $strcalc .= ",$colfield " if ($colfield);
fc1342f rel_3_0 moved to HEAD
tipaul authored
339 # my $max;
340 # if (@loopcol) {
341 # $max = $line*@loopcol;
342 # } else { $max=$line;}
343 # $strcalc .= " LIMIT 0,$max";
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
344
345 $debug and print DEBUG "(old_issues) SQL : $strcalc\n";
a5bd240 FIX for Date calculation
paul authored
346 my $dbcalc = $dbh->prepare($strcalc);
347 $dbcalc->execute;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
348 $debug and print DEBUG "rows: ", $dbcalc->rows, "\n";
349 my %patrons = ();
350 # DATA STRUCTURE is going to look like this:
351 # (2253=> {name=>"John Doe",
352 # allcols=>{MAIN=>12, MEDIA_LIB=>3}
353 # },
354 # )
355 while (my @data = $dbcalc->fetchrow) {
356 my ($row, $rank, $id, $col) = @data;
ac0d340 kohabug 2345: bad comparisons pervade reports
Jesse Weaver authored
357 $col = "zzEMPTY" if (!defined($col));
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
358 unless ($patrons{$id}) {
359 $patrons{$id} = {name=>$row, allcols=>{}, newcols=>{}, oldcols=>{}};
360 }
361 $patrons{$id}->{oldcols}->{$col} = $rank;
a5bd240 FIX for Date calculation
paul authored
362 }
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
363
364 use Data::Dumper;
365
366 $strcalc =~ s/old_issues/issues/g;
367 $debug and print DEBUG "(issues) SQL : $strcalc\n";
368 $dbcalc = $dbh->prepare($strcalc);
369 $dbcalc->execute;
370 $debug and print DEBUG "rows: ", $dbcalc->rows, "\n";
371 while (my @data = $dbcalc->fetchrow) {
372 my ($row, $rank, $id, $col) = @data;
ac0d340 kohabug 2345: bad comparisons pervade reports
Jesse Weaver authored
373 $col = "zzEMPTY" if (!defined($col));
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
374 unless ($patrons{$id}) {
375 $patrons{$id} = {name=>$row, allcols=>{}, newcols=>{}, oldcols=>{}};
376 }
377 $patrons{$id}->{newcols}->{$col} = $rank;
378 }
379
380 foreach my $id (keys %patrons) {
381 my @uniq = keys %{{ %{$patrons{$id}->{newcols}}, %{$patrons{$id}->{oldcols}} }}; # get uniq keys, see perlfaq4
382 foreach (@uniq) {
383 my $count = ($patrons{$id}->{newcols}->{$_} || 0) +
384 ($patrons{$id}->{oldcols}->{$_} || 0);
385 $patrons{$id}->{allcols}->{$_} = $count;
386 $patrons{$id}->{total} += $count;
387 }
388 }
389 $debug and print DEBUG "\n\npatrons: ", Dumper(\%patrons);
a5bd240 FIX for Date calculation
paul authored
390
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
391 my $i = 1;
392 my @cols_in_order = sort keys %columns; # if you want to order the columns, do something here
393 my @ranked_ids = sort {
394 $patrons{$b}->{total} <=> $patrons{$a}->{total}
395 || $patrons{$a}->{name} cmp $patrons{$b}->{name}
396 } keys %patrons;
397 foreach my $id (@ranked_ids) {
a5bd240 FIX for Date calculation
paul authored
398 my @loopcell;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
399 foreach my $key (@cols_in_order) {
400 push @loopcell, {
401 value => $patrons{$id}->{name},
402 count => $patrons{$id}->{allcols}->{$key},
403 reference => $id,
404 };
a5bd240 FIX for Date calculation
paul authored
405 }
9b4bda4 Resolve content and sort problems with report
J. David Bavousett authored
406 if ($i <= $line){
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
407 push @looprow,{ 'rowtitle' => $i++ ,
a5bd240 FIX for Date calculation
paul authored
408 'loopcell' => \@loopcell,
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
409 'hilighted' => ($i%2),
a5bd240 FIX for Date calculation
paul authored
410 };
9b4bda4 Resolve content and sort problems with report
J. David Bavousett authored
411 }
a5bd240 FIX for Date calculation
paul authored
412 }
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
413
a5bd240 FIX for Date calculation
paul authored
414 # the header of the table
415 $globalline{loopfilter}=\@loopfilter;
416 # the core of the table
417 $globalline{looprow} = \@looprow;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
418 $globalline{loopcol} = [ map {+{coltitle=>$_}} @cols_in_order ];
419 # the foot (totals by borrower type)
420 $globalline{loopfooter} = [];
421 $globalline{total}= $grantotal; # FIXME: useless
a5bd240 FIX for Date calculation
paul authored
422 $globalline{line} = $line;
423 $globalline{column} = $column;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
424 return [\%globalline]; # reference to a 1 element array: that element is a hashref
4bf980d Fixes on issues_avg_stats
hdl authored
425 }
426
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
427 $debug and close DEBUG;
fc1342f rel_3_0 moved to HEAD
tipaul authored
428 1;
b1fbee4 Total overhaul of bor_issues_top report, removal from CGI::scolling_l…
Joe Atzberger authored
429 __END__
Something went wrong with that request. Please try again.