Bug Fixing:
[koha.git] / reports / acquisitions_stats.pl
1 #!/usr/bin/perl
2
3 # $Id$
4
5 # Copyright 2000-2002 Katipo Communications
6 #
7 # This file is part of Koha.
8 #
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
12 # version.
13 #
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.
17 #
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
21
22 # test comment
23
24 use strict;
25 use C4::Auth;
26 use CGI;
27 use C4::Context;
28
29 use C4::Output;
30 use C4::Koha;
31 use C4::Circulation;
32
33 =head1 NAME
34
35 plugin that shows a stats on borrowers
36
37 =head1 DESCRIPTION
38
39
40 =over2
41
42 =cut
43
44 my $input          = new CGI;
45 my $do_it          = $input->param('do_it');
46 my $fullreportname = "reports/acquisitions_stats.tmpl";
47 my $line           = $input->param("Line");
48 my $column         = $input->param("Column");
49 my @filters        = $input->param("Filter");
50 my $podsp          = $input->param("PlacedOnDisplay");
51 my $rodsp          = $input->param("ReceivedOnDisplay");
52 my $aodsp          = $input->param("AcquiredOnDisplay");    ##added by mason.
53 my $calc           = $input->param("Cellvalue");
54 my $output         = $input->param("output");
55 my $basename       = $input->param("basename");
56 my $mime           = $input->param("MIME");
57 my $del            = $input->param("sep");
58
59 #warn "calcul : ".$calc;
60 my ($template, $borrowernumber, $cookie)
61         = get_template_and_user({template_name => $fullreportname,
62                                 query => $input,
63                                 type => "intranet",
64                                 authnotrequired => 0,
65                                 flagsrequired => {reports => 1},
66                                 debug => 1,
67                                 });
68 $template->param(do_it => $do_it,
69                 intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
70                 intranetstylesheet => C4::Context->preference("intranetstylesheet"),
71                 IntranetNav => C4::Context->preference("IntranetNav"),
72                 );
73 if ($do_it) {
74
75     #warn
76 "line=$line, col=$column, pod=$podsp, rod=$rodsp, aod=$aodsp, calc=$calc, filters=@filters\n";
77
78     my $results =
79       calculate( $line, $column, $podsp, $rodsp, $aodsp, $calc, \@filters );
80     if ( $output eq "screen" ) {
81         $template->param( mainloop => $results );
82         output_html_with_http_headers $input, $cookie, $template->output;
83         exit(1);
84     }
85     else {
86         print $input->header(
87             -type       => 'application/vnd.sun.xml.calc',
88             -encoding    => 'utf-8',
89             -attachment => "$basename.csv",
90             -name       => "$basename.csv"
91         );
92         my $cols  = @$results[0]->{loopcol};
93         my $lines = @$results[0]->{looprow};
94         my $sep;
95         $sep = C4::Context->preference("delimiter");
96         print @$results[0]->{line} . "/" . @$results[0]->{column} . $sep;
97         foreach my $col (@$cols) {
98             print $col->{coltitle} . $sep;
99         }
100         print "Total\n";
101         foreach my $line (@$lines) {
102             my $x = $line->{loopcell};
103             print $line->{rowtitle} . $sep;
104             foreach my $cell (@$x) {
105                 print $cell->{value} . $sep;
106             }
107             print $line->{totalrow};
108             print "\n";
109         }
110         print "TOTAL";
111         $cols = @$results[0]->{loopfooter};
112         foreach my $col (@$cols) {
113             print $sep. $col->{totalcol};
114         }
115         print $sep. @$results[0]->{total};
116         exit(1);
117     }
118 }
119 else {
120     my $dbh = C4::Context->dbh;
121     my @values;
122     my %labels;
123     my %select;
124     my $req;
125     $req =
126       $dbh->prepare(
127         "SELECT distinctrow id,name FROM aqbooksellers ORDER BY name");
128     $req->execute;
129     my @select;
130     push @select, "";
131
132     #       $select{""}="";
133     while ( my ( $value, $desc ) = $req->fetchrow ) {
134         push @select, $desc;
135
136         #               $select{$value}=$desc;
137     }
138     my $CGIBookSellers = CGI::scrolling_list(
139         -name   => 'Filter',
140         -id     => 'Filter',
141         -values => \@select,
142
143         #                               -labels   => \%select,
144         -size     => 1,
145         -multiple => 0
146     );
147
148     $req =
149       $dbh->prepare(
150 "SELECT DISTINCTROW itemtype,description FROM itemtypes ORDER BY description"
151       );
152     $req->execute;
153     undef @select;
154     undef %select;
155     push @select, "";
156     $select{""} = "";
157     while ( my ( $value, $desc ) = $req->fetchrow ) {
158         push @select, $value;
159         $select{$value} = $desc;
160     }
161     my $CGIItemTypes = CGI::scrolling_list(
162         -name     => 'Filter',
163         -id       => 'Filter',
164         -values   => \@select,
165         -labels   => \%select,
166         -size     => 1,
167         -multiple => 0
168     );
169
170     $req =
171       $dbh->prepare(
172 "SELECT DISTINCTROW bookfundid,bookfundname FROM aqbookfund ORDER BY bookfundname"
173       );
174     $req->execute;
175     undef @select;
176     undef %select;
177     push @select, "";
178     $select{""} = "";
179
180     while ( my ( $value, $desc ) = $req->fetchrow ) {
181         push @select, $value;
182         $select{$value} = $desc;
183     }
184     my $CGIBudget = CGI::scrolling_list(
185         -name     => 'Filter',
186         -id       => 'Filter',
187         -values   => \@select,
188         -labels   => \%select,
189         -size     => 1,
190         -multiple => 0
191     );
192
193     $req =
194       $dbh->prepare(
195 "SELECT DISTINCTROW sort1 FROM aqorders WHERE sort1 IS NOT NULL ORDER BY sort1"
196       );
197     $req->execute;
198     undef @select;
199     push @select, "";
200     my $hassort1;
201     while ( my ($value) = $req->fetchrow ) {
202         $hassort1 = 1 if ($value);
203         push @select, $value;
204     }
205     my $CGISort1 = CGI::scrolling_list(
206         -name     => 'Filter',
207         -id       => 'Filter',
208         -values   => \@select,
209         -size     => 1,
210         -multiple => 0
211     );
212
213     $req =
214       $dbh->prepare(
215 "SELECT DISTINCTROW sort2 FROM aqorders WHERE sort2 IS NOT NULL ORDER BY sort2"
216       );
217     $req->execute;
218     undef @select;
219     push @select, "";
220     my $hassort2;
221     my $hglghtsort2;
222
223     while ( my ($value) = $req->fetchrow ) {
224         $hassort2 = 1 if ($value);
225         $hglghtsort2 = !($hassort1);
226         push @select, $value;
227     }
228     my $CGISort2 = CGI::scrolling_list(
229         -name     => 'Filter',
230         -id       => 'Filter',
231         -values   => \@select,
232         -size     => 1,
233         -multiple => 0
234     );
235
236     my @mime = ( C4::Context->preference("MIME") );
237     foreach my $mime (@mime) {
238
239         #               warn "".$mime;
240     }
241
242     my $CGIextChoice = CGI::scrolling_list(
243         -name     => 'MIME',
244         -id       => 'MIME',
245         -values   => \@mime,
246         -size     => 1,
247         -multiple => 0
248     );
249
250     my @dels         = ( C4::Context->preference("delimiter") );
251     my $CGIsepChoice = CGI::scrolling_list(
252         -name     => 'sep',
253         -id       => 'sep',
254         -values   => \@dels,
255         -size     => 1,
256         -multiple => 0
257     );
258
259     $template->param(
260         CGIBookSeller => $CGIBookSellers,
261         CGIItemType   => $CGIItemTypes,
262         CGIBudget     => $CGIBudget,
263         hassort1      => $hassort1,
264         hassort2      => $hassort2,
265         HlghtSort2    => $hglghtsort2,
266         CGISort1      => $CGISort1,
267         CGISort2      => $CGISort2,
268         CGIextChoice  => $CGIextChoice,
269         CGIsepChoice  => $CGIsepChoice
270     );
271
272 }
273 output_html_with_http_headers $input, $cookie, $template->output;
274
275 sub calculate {
276     my ( $line, $column, $podsp, $rodsp, $aodsp, $process, $filters ) = @_;
277     my @mainloop;
278     my @loopfooter;
279     my @loopcol;
280     my @loopline;
281     my @looprow;
282     my %globalline;
283     my $grantotal = 0;
284
285     # extract parameters
286     my $dbh = C4::Context->dbh;
287
288     # Filters
289     # Checking filters
290     #
291     my @loopfilter;
292     for ( my $i = 0 ; $i <= 8 ; $i++ ) {
293         my %cell;
294         if ( @$filters[$i] ) {
295             if ( ( ( $i == 1 ) or ( $i == 3 ) ) and ( @$filters[ $i - 1 ] ) ) {
296                 $cell{err} = 1 if ( @$filters[$i] < @$filters[ $i - 1 ] );
297             }
298             $cell{filter} .= @$filters[$i];
299             $cell{crit}   .= "Placed On From" if ( $i == 0 );
300             $cell{crit}   .= "Placed On To" if ( $i == 1 );
301             $cell{crit}   .= "Received On From" if ( $i == 2 );
302             $cell{crit}   .= "Received On To" if ( $i == 3 );
303
304             $cell{crit} .= "Acquired On From" if ( $i == 4 );
305             $cell{crit} .= "Acquired On To"   if ( $i == 5 );
306
307             $cell{crit} .= "BookSeller" if ( $i == 6 );
308             $cell{crit} .= "Doc Type"   if ( $i == 7 );
309             $cell{crit} .= "Budget"     if ( $i == 8 );
310             $cell{crit} .= "Sort1"      if ( $i == 9 );
311             $cell{crit} .= "Sort2"      if ( $i == 10 );
312             push @loopfilter, \%cell;
313         }
314     }
315
316     my @linefilter;
317
318     #       warn "filtres ".@filters[0];
319     #       warn "filtres ".@filters[1];
320     #       warn "filtres ".@filters[2];
321     #       warn "filtres ".@filters[3];
322
323     $linefilter[0] = @$filters[0] if ( $line =~ /closedate/ );
324     $linefilter[1] = @$filters[1] if ( $line =~ /closedate/ );
325     $linefilter[0] = @$filters[2] if ( $line =~ /received/ );
326     $linefilter[1] = @$filters[3] if ( $line =~ /received/ );
327
328     $linefilter[0] = @$filters[4] if ( $line =~ /acquired/ );
329     $linefilter[1] = @$filters[5] if ( $line =~ /acquired/ );
330
331     $linefilter[0] = @$filters[6]  if ( $line =~ /bookseller/ );
332     $linefilter[0] = @$filters[7]  if ( $line =~ /itemtype/ );
333     $linefilter[0] = @$filters[8]  if ( $line =~ /bookfund/ );
334     $linefilter[0] = @$filters[9]  if ( $line =~ /sort1/ );
335     $linefilter[0] = @$filters[10] if ( $line =~ /sort2/ );
336
337     #warn "filtre lignes".$linefilter[0]." ".$linefilter[1];
338     #
339     my @colfilter;
340     $colfilter[0] = @$filters[0] if ( $column =~ /closedate/ );
341     $colfilter[1] = @$filters[1] if ( $column =~ /closedate/ );
342     $colfilter[0] = @$filters[2] if ( $column =~ /received/ );
343     $colfilter[1] = @$filters[3] if ( $column =~ /received/ );
344
345     $colfilter[0] = @$filters[4] if ( $column =~ /acquired/ );
346     $colfilter[1] = @$filters[5] if ( $column =~ /acquired/ );
347
348     $colfilter[0] = @$filters[6]  if ( $column =~ /bookseller/ );
349     $colfilter[0] = @$filters[7]  if ( $column =~ /itemtype/ );
350     $colfilter[0] = @$filters[8]  if ( $column =~ /bookfund/ );
351     $colfilter[0] = @$filters[9]  if ( $column =~ /sort1/ );
352     $colfilter[0] = @$filters[10] if ( $column =~ /sort2/ );
353
354     #warn "filtre col ".$colfilter[0]." ".$colfilter[1];
355
356     #warn "line=$line, podsp=$podsp, rodsp=$rodsp, aodsp=$aodsp\n";
357
358     # 1st, loop rows.
359     my $linefield;
360     if ( ( $line =~ /closedate/ ) and ( $podsp == 1 ) ) {
361
362         #Display by day
363         $linefield .= "dayname($line)";
364     }
365     elsif ( ( $line =~ /closedate/ ) and ( $podsp == 2 ) ) {
366
367         #Display by Month
368         $linefield .= "monthname($line)";
369     }
370     elsif ( ( $line =~ /closedate/ ) and ( $podsp == 3 ) ) {
371
372         #Display by Year
373         $linefield .= "Year($line)";
374
375     }
376     elsif ( ( $line =~ /received/ ) and ( $rodsp == 1 ) ) {
377
378         #Display by day
379         $linefield .= "dayname($line)";
380     }
381     elsif ( ( $line =~ /received/ ) and ( $rodsp == 2 ) ) {
382
383         #Display by Month
384         $linefield .= "monthname($line)";
385     }
386     elsif ( ( $line =~ /received/ ) and ( $rodsp == 3 ) ) {
387
388         #Display by Year
389         $linefield .= "Year($line)";
390
391     }
392     elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 1 ) ) {
393
394         #Display by day
395         $linefield .= "dayname($line)";
396     }
397     elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 2 ) ) {
398
399         #Display by Month
400         $linefield .= "monthname($line)";
401     }
402     elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 3 ) ) {
403
404         #Display by Year
405         $linefield .= "Year($line)";
406
407     }
408     else {
409         $linefield .= $line;
410     }
411
412     my $strsth;
413     $strsth .=
414       "SELECT DISTINCTROW $linefield FROM (aqorders, aqbasket,aqorderbreakdown)
415                 LEFT JOIN items ON (aqorders.biblioitemnumber= items.biblioitemnumber)
416                 LEFT JOIN biblioitems ON (aqorders.biblioitemnumber= biblioitems.biblioitemnumber)
417                 LEFT JOIN aqorderdelivery ON (aqorders.ordernumber =aqorderdelivery.ordernumber )
418                 LEFT JOIN aqbooksellers ON (aqbasket.booksellerid=aqbooksellers.id) WHERE (aqorders.basketno=aqbasket.basketno)
419                 AND (aqorderbreakdown.ordernumber=aqorders.ordernumber) AND $line IS NOT NULL ";
420
421     if (@linefilter) {
422         if ( $linefilter[1] ) {
423             if ( $linefilter[0] ) {
424                 $strsth .= " AND $line BETWEEN ? AND ? ";
425             }
426             else {
427                 $strsth .= " AND $line < ? ";
428             }
429         }
430         elsif (
431             ( $linefilter[0] )
432             and (  ( $line =~ /closedate/ )
433                 or ( $line =~ /received/ )
434                 or ( $line =~ /acquired/ ) )
435           )
436         {
437             $strsth .= " AND $line > ? ";
438         }
439         elsif ( $linefilter[0] ) {
440             $linefilter[0] =~ s/\*/%/g;
441             $strsth .= " AND $line LIKE ? ";
442         }
443     }
444     $strsth .= " GROUP BY $linefield";
445     $strsth .= " ORDER BY $linefield";
446
447     #warn "377:strsth= $strsth";
448
449     my $sth = $dbh->prepare($strsth);
450     if ( (@linefilter) and ( $linefilter[1] ) ) {
451         $sth->execute( "'" . $linefilter[0] . "'", "'" . $linefilter[1] . "'" );
452     }
453     elsif ( $linefilter[0] ) {
454         $sth->execute( $linefilter[0] );
455     }
456     else {
457         $sth->execute;
458     }
459
460     while ( my ($celvalue) = $sth->fetchrow ) {
461         my %cell;
462         if ($celvalue) {
463             $cell{rowtitle} = $celvalue;
464
465             #               } else {
466             #                       $cell{rowtitle} = "";
467         }
468         $cell{totalrow} = 0;
469         push @loopline, \%cell;
470     }
471
472     #warn "column=$column, podsp=$podsp, rodsp=$rodsp, aodsp=$aodsp\n";
473
474     # 2nd, loop cols.
475     my $colfield;
476     if ( ( $column =~ /closedate/ ) and ( $podsp == 1 ) ) {
477
478         #Display by day
479         $colfield .= "dayname($column)";
480     }
481     elsif ( ( $column =~ /closedate/ ) and ( $podsp == 2 ) ) {
482
483         #Display by Month
484         $colfield .= "monthname($column)";
485     }
486     elsif ( ( $column =~ /closedate/ ) and ( $podsp == 3 ) ) {
487
488         #Display by Year
489         $colfield .= "Year($column)";
490
491     }
492     elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 1 ) ) {
493
494         #Display by day
495         $colfield .= "dayname($column)";
496     }
497     elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 2 ) ) {
498
499         #Display by Month
500         $colfield .= "monthname($column)";
501     }
502     elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 3 ) ) {
503
504         #Display by Year
505         $colfield .= "Year($column)";
506
507     }
508     elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 1 ) ) {
509
510         #Display by day
511         $colfield .= "dayname($column)";
512     }
513     elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 2 ) ) {
514
515         #Display by Month
516         $colfield .= "monthname($column)";
517     }
518     elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 3 ) ) {
519
520         #Display by Year
521         $colfield .= "Year($column)";
522
523     }
524     else {
525         $colfield .= $column;
526     }
527
528     my $strsth2;
529     $strsth2 .=
530       "SELECT distinctrow $colfield FROM (aqorders, aqbasket,aqorderbreakdown)
531                  LEFT JOIN items ON (aqorders.biblioitemnumber= items.biblioitemnumber)
532                  LEFT JOIN biblioitems ON (aqorders.biblioitemnumber= biblioitems.biblioitemnumber)
533                  LEFT JOIN aqorderdelivery ON (aqorders.ordernumber =aqorderdelivery.ordernumber )
534                  LEFT JOIN aqbooksellers ON (aqbasket.booksellerid=aqbooksellers.id)
535                  WHERE (aqorders.basketno=aqbasket.basketno) AND (aqorderbreakdown.ordernumber=aqorders.ordernumber)
536                  AND $column IS NOT NULL";
537
538     if (@colfilter) {
539         if ( $colfilter[1] ) {
540             if ( $colfilter[0] ) {
541                 $strsth2 .= " AND $column BETWEEN  ? AND ? ";
542             }
543             else {
544                 $strsth2 .= " AND $column < ? ";
545             }
546         }
547         elsif (
548             ( $colfilter[0] )
549             and (  ( $column =~ /closedate/ )
550                 or ( $line =~ /received/ )
551                 or ( $line =~ /acquired/ ) )
552           )
553         {
554             $strsth2 .= " AND $column > ? ";
555         }
556         elsif ( $colfilter[0] ) {
557             $colfilter[0] =~ s/\*/%/g;
558             $strsth2 .= " AND $column LIKE ? ";
559         }
560     }
561     $strsth2 .= " GROUP BY $colfield";
562     $strsth2 .= " ORDER BY $colfield";
563
564     #        warn "MASON:. $strsth2";
565
566     my $sth2 = $dbh->prepare($strsth2);
567     if ( (@colfilter) and ( $colfilter[1] ) ) {
568
569         #                warn "from : ".$colfilter[0]." To  :".$colfilter[1];
570         $sth2->execute( "'" . $colfilter[0] . "'", "'" . $colfilter[1] . "'" );
571     }
572     elsif ( $colfilter[0] ) {
573         $sth2->execute( $colfilter[0] );
574     }
575     else {
576         $sth2->execute;
577     }
578
579     while ( my ($celvalue) = $sth2->fetchrow ) {
580         my %cell;
581         if ($celvalue) {
582
583             #               warn "coltitle :".$celvalue;
584             $cell{coltitle} = $celvalue;
585         }
586         push @loopcol, \%cell;
587     }
588
589     #       warn "fin des titres colonnes";
590
591     my $i = 0;
592     my @totalcol;
593     my $hilighted = -1;
594
595     #Initialization of cell values.....
596     my %table;
597
598     #       warn "init table";
599     foreach my $row (@loopline) {
600         foreach my $col (@loopcol) {
601
602 #                       warn " init table : $row->{rowtitle} / $col->{coltitle} ";
603             $table{ $row->{rowtitle} }->{ $col->{coltitle} } = 0;
604         }
605         $table{ $row->{rowtitle} }->{totalrow} = 0;
606     }
607
608     # preparing calculation
609     my $strcalc;
610     $strcalc .= "SELECT $linefield, $colfield, ";
611     $strcalc .= "SUM( aqorders.quantity ) " if ( $process == 1 );
612     $strcalc .= "SUM( aqorders.quantity * aqorders.listprice ) "
613       if ( $process == 2 );
614     $strcalc .= "FROM (aqorders, aqbasket,aqorderbreakdown)
615                  LEFT JOIN items ON (aqorders.biblioitemnumber= items.biblioitemnumber)
616                  LEFT JOIN biblioitems ON (aqorders.biblioitemnumber= biblioitems.biblioitemnumber)
617                  LEFT JOIN aqorderdelivery ON (aqorders.ordernumber =aqorderdelivery.ordernumber )
618                  LEFT JOIN aqbooksellers ON (aqbasket.booksellerid=aqbooksellers.id) WHERE (aqorders.basketno=aqbasket.basketno)
619                       AND (aqorderbreakdown.ordernumber=aqorders.ordernumber) ";
620
621     @$filters[0] =~ s/\*/%/g if ( @$filters[0] );
622     $strcalc .= " AND aqbasket.closedate > '" . @$filters[0] . "'"
623       if ( @$filters[0] );
624     @$filters[1] =~ s/\*/%/g if ( @$filters[1] );
625     $strcalc .= " AND aqbasket.closedate < '" . @$filters[1] . "'"
626       if ( @$filters[1] );
627     @$filters[2] =~ s/\*/%/g if ( @$filters[2] );
628     $strcalc .= " AND aqorderdelivery.deliverydate > '" . @$filters[2] . "'"
629       if ( @$filters[2] );
630     @$filters[3] =~ s/\*/%/g if ( @$filters[3] );
631     $strcalc .= " AND aqorderdelivery.deliverydate < '" . @$filters[3] . "'"
632       if ( @$filters[3] );
633     @$filters[4] =~ s/\*/%/g if ( @$filters[4] );
634     $strcalc .= " AND aqbasket.closedate > '" . @$filters[4] . "'"
635       if ( @$filters[4] );
636     @$filters[5] =~ s/\*/%/g if ( @$filters[5] );
637     $strcalc .= " AND aqbasket.closedate < '" . @$filters[5] . "'"
638       if ( @$filters[5] );
639     @$filters[6] =~ s/\*/%/g if ( @$filters[6] );
640     $strcalc .= " AND aqbooksellers.name LIKE '" . @$filters[6] . "'"
641       if ( @$filters[6] );
642     @$filters[7] =~ s/\*/%/g if ( @$filters[7] );
643     $strcalc .= " AND biblioitems.itemtype LIKE '" . @$filters[7] . "'"
644       if ( @$filters[7] );
645     @$filters[8] =~ s/\*/%/g if ( @$filters[8] );
646     $strcalc .= " AND aqbookfund.bookfundid LIKE '" . @$filters[8] . "'"
647       if ( @$filters[8] );
648     @$filters[9] =~ s/\*/%/g if ( @$filters[9] );
649     $strcalc .= " AND aqorders.sort1 LIKE '" . @$filters[9] . "'"
650       if ( @$filters[9] );
651     @$filters[10] =~ s/\*/%/g if ( @$filters[10] );
652     $strcalc .= " AND aqorders.sort2 LIKE '" . @$filters[10] . "'"
653       if ( @$filters[10] );
654     $strcalc .= " GROUP BY $linefield, $colfield ORDER BY $linefield,$colfield";
655
656     #        warn "/n/n". $strcalc;
657     my $dbcalc = $dbh->prepare($strcalc);
658     $dbcalc->execute;
659
660     #       warn "filling table";
661     my $emptycol;
662     while ( my ( $row, $col, $value ) = $dbcalc->fetchrow ) {
663
664         #              warn "filling table $row / $col / $value ";
665         $emptycol = 1         if ( $col eq undef );
666         $col      = "zzEMPTY" if ( $col eq undef );
667         $row      = "zzEMPTY" if ( $row eq undef );
668
669         $table{$row}->{$col}     += $value;
670         $table{$row}->{totalrow} += $value;
671         $grantotal               += $value;
672     }
673
674     push @loopcol, { coltitle => "NULL" } if ($emptycol);
675
676     foreach my $row ( sort keys %table ) {
677         my @loopcell;
678
679         #@loopcol ensures the order for columns is common with column titles
680         # and the number matches the number of columns
681         foreach my $col (@loopcol) {
682             my $value = $table{$row}->{
683                 ( $col->{coltitle} eq "NULL" )
684                 ? "zzEMPTY"
685                 : $col->{coltitle}
686               };
687             push @loopcell, { value => $value };
688         }
689         push @looprow,
690           {
691             'rowtitle' => ( $row eq "zzEMPTY" ) ? "NULL" : $row,
692             'loopcell'  => \@loopcell,
693             'hilighted' => ( $hilighted > 0 ),
694             'totalrow'  => $table{$row}->{totalrow}
695           };
696         $hilighted = -$hilighted;
697     }
698
699     #       warn "footer processing";
700     foreach my $col (@loopcol) {
701         my $total = 0;
702         foreach my $row (@looprow) {
703             $total += $table{
704                 ( $row->{rowtitle} eq "NULL" ) ? "zzEMPTY"
705                 : $row->{rowtitle}
706               }->{
707                 ( $col->{coltitle} eq "NULL" ) ? "zzEMPTY"
708                 : $col->{coltitle}
709               };
710
711 #                       warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle};
712         }
713
714         #               warn "summ for column ".$col->{coltitle}."  = ".$total;
715         push @loopfooter, { 'totalcol' => $total };
716     }
717
718     # the header of the table
719     #        $globalline{loopfilter}=\@loopfilter;
720     # the core of the table
721     $globalline{looprow} = \@looprow;
722     $globalline{loopcol} = \@loopcol;
723
724     #       # the foot (totals by borrower type)
725     $globalline{loopfooter} = \@loopfooter;
726     $globalline{total}      = $grantotal;
727     $globalline{line}       = $line;
728     $globalline{column}     = $column;
729     push @mainloop, \%globalline;
730     return \@mainloop;
731 }
732
733 1;
734