Bug 9634: Allow for combining same paraneters in SQL reports
[koha.git] / reports / acquisitions_stats.pl
1 #!/usr/bin/perl
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
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.
11 #
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.
16 #
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>.
19
20 use Modern::Perl;
21
22 use C4::Auth;
23 use CGI qw ( -utf8 );
24 use C4::Context;
25 use C4::Reports;
26 use C4::Output;
27 use C4::Koha;
28 use C4::Circulation;
29 use C4::Biblio;
30 use Koha::ItemTypes;
31 use Koha::DateUtils;
32 use Koha::Libraries;
33
34 =head1 NAME
35
36 reports/acquisitions_stats.pl
37
38 =head1 DESCRIPTION
39
40 Plugin that shows a stats on borrowers
41
42 =cut
43
44 my $input          = new CGI;
45 my $do_it          = $input->param('do_it');
46 my $fullreportname = "reports/acquisitions_stats.tt";
47 my $line           = $input->param("Line");
48 my $column         = $input->param("Column");
49 my @filters        = $input->multi_param("Filter");
50 $filters[0] = eval { output_pref( { dt => dt_from_string( $filters[0]), dateonly => 1, dateformat => 'iso' } ); }
51     if ( $filters[0] );
52 $filters[1] = eval { output_pref( { dt => dt_from_string( $filters[1]), dateonly => 1, dateformat => 'iso' } ); }
53     if ( $filters[1] );
54 $filters[2] = eval { output_pref( { dt => dt_from_string( $filters[2]), dateonly => 1, dateformat => 'iso' } ); }
55     if ( $filters[2] );
56 $filters[3] = eval { output_pref( { dt => dt_from_string( $filters[3]), dateonly => 1, dateformat => 'iso' } ); }
57     if ( $filters[3] );
58 my $podsp          = $input->param("PlacedOnDisplay");
59 my $rodsp          = $input->param("ReceivedOnDisplay");
60 my $calc           = $input->param("Cellvalue");
61 my $output         = $input->param("output");
62 my $basename       = $input->param("basename");
63
64 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
65     {
66         template_name   => $fullreportname,
67         query           => $input,
68         type            => "intranet",
69         authnotrequired => 0,
70         flagsrequired   => { reports => '*' },
71         debug           => 1,
72     }
73 );
74
75 our $sep     = $input->param("sep") // '';
76 $sep = "\t" if ($sep eq 'tabulation');
77
78 $template->param(
79     do_it                    => $do_it,
80 );
81
82 if ($do_it) {
83     my $results =
84       calculate( $line, $column, $podsp, $rodsp, $calc, \@filters );
85     if ( $output eq "screen" ) {
86         $template->param( mainloop => $results );
87         output_html_with_http_headers $input, $cookie, $template->output;
88     }
89     else {
90         print $input->header(
91             -type       => 'application/vnd.sun.xml.calc',
92             -encoding    => 'utf-8',
93             -attachment => "$basename.csv",
94             -name       => "$basename.csv"
95         );
96         my $cols  = @$results[0]->{loopcol};
97         my $lines = @$results[0]->{looprow};
98         print @$results[0]->{line} . "/" . @$results[0]->{column} . $sep;
99         foreach my $col (@$cols) {
100             print $col->{coltitle} . $sep;
101         }
102         print "Total\n";
103         foreach my $line (@$lines) {
104             my $x = $line->{loopcell};
105             print $line->{rowtitle} . $sep;
106             foreach my $cell (@$x) {
107                 print $cell->{value} . $sep;
108             }
109             print $line->{totalrow};
110             print "\n";
111         }
112         print "TOTAL";
113         $cols = @$results[0]->{loopfooter};
114         foreach my $col (@$cols) {
115             print $sep. $col->{totalcol};
116         }
117         print $sep. @$results[0]->{total};
118     }
119     exit;
120 }
121 else {
122     my $dbh = C4::Context->dbh;
123     my $req;
124     $req = $dbh->prepare("SELECT distinctrow id,name FROM aqbooksellers ORDER BY name");
125     $req->execute;
126     my $booksellers = $req->fetchall_arrayref({});
127
128     $req = $dbh->prepare("SELECT DISTINCTROW budget_code, budget_name FROM aqbudgets ORDER BY budget_name");
129     $req->execute;
130     my @bselect;
131     my %bselect;
132
133     while ( my ( $value, $desc ) = $req->fetchrow ) {
134         push @bselect, $value;
135         $bselect{$value} = $desc;
136     }
137     my $Budgets = {
138         values   => \@bselect,
139         labels   => \%bselect,
140     };
141
142     $req =
143       $dbh->prepare(
144 "SELECT DISTINCTROW sort1 FROM aqorders WHERE sort1 IS NOT NULL ORDER BY sort1"
145       );
146     $req->execute;
147     my @s1select;
148     my %s1select;
149     my $hassort1;
150     while ( my ($value) = $req->fetchrow ) {
151         if ($value) {
152             $hassort1 = 1;
153             push @s1select, $value;
154             $s1select{$value} = $value;
155         }
156     }
157     my $Sort1 = {
158         values   => \@s1select,
159         labels   => \%s1select,
160     };
161
162     $req =
163       $dbh->prepare(
164 "SELECT DISTINCTROW sort2 FROM aqorders WHERE sort2 IS NOT NULL ORDER BY sort2"
165       );
166     $req->execute;
167     my @s2select;
168     my %s2select;
169     my $hassort2;
170     my $hglghtsort2;
171
172     while ( my ($value) = $req->fetchrow ) {
173         if ($value) {
174             $hassort2    = 1;
175             $hglghtsort2 = !($hassort1);
176             push @s2select, $value;
177             $s2select{$value} = $value;
178         }
179     }
180     my $Sort2 = {
181         values   => \@s2select,
182         labels   => \%s2select,
183     };
184
185     my $CGIsepChoice = GetDelimiterChoices;
186
187     my @branches = Koha::Libraries->search({}, { order_by => 'branchname' });
188
189     my $ccode_subfield_structure = GetMarcSubfieldStructureFromKohaField('items.ccode');
190     my $ccode_label;
191     my $ccode_avlist;
192     if($ccode_subfield_structure) {
193         $ccode_label = $ccode_subfield_structure->{liblibrarian};
194         $ccode_avlist = GetAuthorisedValues($ccode_subfield_structure->{authorised_value});
195     }
196
197     my $itemtypes = Koha::ItemTypes->search_with_localization;
198     $template->param(
199         booksellers   => $booksellers,
200         itemtypes     => $itemtypes, # FIXME Should use the TT plugin instead
201         Budgets       => $Budgets,
202         hassort1      => $hassort1,
203         hassort2      => $hassort2,
204         Sort1         => $Sort1,
205         Sort2         => $Sort2,
206         CGIsepChoice  => $CGIsepChoice,
207         branches      => \@branches,
208         ccode_label   => $ccode_label,
209         ccode_avlist  => $ccode_avlist,
210     );
211
212 }
213 output_html_with_http_headers $input, $cookie, $template->output;
214
215 sub calculate {
216     my ( $line, $column, $podsp, $rodsp, $process, $filters ) = @_;
217     my @mainloop;
218     my @loopfooter;
219     my @loopcol;
220     my @loopline;
221     my @looprow;
222     my %globalline;
223     my $grantotal = 0;
224
225     $podsp ||= 0;
226     $rodsp ||= 0;
227
228     # extract parameters
229     my $dbh = C4::Context->dbh;
230
231     # Filters
232     # Checking filters
233     #
234     my @loopfilter;
235     for ( my $i = 0 ; $i <= @$filters ; $i++ ) {
236         if( defined @$filters[$i] and @$filters[$i] ne '' ) {
237             my %cell;
238             if ( ( ( $i == 1 ) or ( $i == 3 ) ) and ( @$filters[ $i - 1 ] ) ) {
239                 $cell{err} = 1 if ( @$filters[$i] lt @$filters[ $i - 1 ] );
240             }
241             # format the dates filters, otherwise just fill as is
242             if ($i >= 4) {
243                 $cell{filter} = @$filters[$i];
244             } else {
245                 $cell{filter} = eval { output_pref( { dt => dt_from_string( @$filters[$i] ), dateonly => 1 }); }
246                    if ( @$filters[$i] );
247             }
248             $cell{crit} = $i;
249             push @loopfilter, \%cell;
250         }
251     }
252
253     my %filter;
254     my %field;
255     foreach ($line, $column) {
256         $filter{$_} = [];
257         $field{$_} = $_;
258         if ( $_ =~ /closedate/ ) {
259             $filter{$_}->[0] = @$filters[0];
260             $filter{$_}->[1] = @$filters[1];
261             my $a = $_;
262             if ( $podsp == 1 ) {
263                 $field{$a} = "concat(hex(weekday($a)+1),'-',dayname($a))";
264             } elsif ( $podsp == 2 ) {
265                 $field{$a} = "concat(hex(month($a)),'-',monthname($a))";
266             } elsif ( $podsp == 3 ) {
267                 $field{$a} = "Year($a)";
268             } else {
269                 $field{$a} = $a;
270             }
271         }
272         elsif ( $_ =~ /received/ ) {
273             $filter{$_}->[0] = @$filters[2];
274             $filter{$_}->[1] = @$filters[3];
275             my $a = $_;
276             if ( $rodsp == 1 ) {
277                 $field{$a} = "concat(hex(weekday($a)+1),'-',dayname($a))";
278             } elsif ( $rodsp == 2 ) {
279                 $field{$a} = "concat(hex(month($a)),'-',monthname($a))";
280             } elsif ( $rodsp == 3 ) {
281                 $field{$a} = "Year($a)";
282             } else {
283                 $field{$a} = $a;
284             }
285         }
286         elsif ( $_ =~ /bookseller/ ) {
287             $filter{$_}->[0] = @$filters[4];
288         }
289         elsif ( $_ =~ /homebranch/ ) {
290             $filter{$_}->[0] = @$filters[5];
291         }
292         elsif ( $_ =~ /ccode/ ) {
293             $filter{$_}->[0] = @$filters[6];
294         }
295         elsif ( $_ =~ /itemtype/ ) {
296             $filter{$_}->[0] = @$filters[7];
297         }
298         elsif ( $_ =~ /budget/ ) {
299             $filter{$_}->[0] = @$filters[8];
300         }
301         elsif ( $_ =~ /sort1/ ) {
302             $filter{$_}->[0] = @$filters[9];
303         }
304         elsif ( $_ =~ /sort2/ ) {
305             $filter{$_}->[0] = @$filters[10];
306         }
307     }
308
309     my @linefilter = @{ $filter{$line} };
310     my $linefield = $field{$line};
311     my @colfilter = @{ $filter{$column} };
312     my $colfield = $field{$column};
313
314     # 1st, loop rows.
315     my $strsth = "
316         SELECT DISTINCTROW $linefield
317         FROM aqorders
318           LEFT JOIN aqbasket ON (aqorders.basketno = aqbasket.basketno)
319           LEFT JOIN aqorders_items ON (aqorders.ordernumber = aqorders_items.ordernumber)
320           LEFT JOIN items ON (aqorders_items.itemnumber = items.itemnumber)
321           LEFT JOIN biblioitems ON (aqorders.biblionumber = biblioitems.biblionumber)
322           LEFT JOIN aqbudgets  ON (aqorders.budget_id = aqbudgets.budget_id )
323           LEFT JOIN aqbooksellers ON (aqbasket.booksellerid = aqbooksellers.id)
324         WHERE $line IS NOT NULL AND $line <> '' ";
325
326     if (@linefilter) {
327         if ( $linefilter[1] ) {
328             if ( $linefilter[0] ) {
329                 $strsth .= " AND $line BETWEEN ? AND ? ";
330             }
331             else {
332                 $strsth .= " AND $line <= ? ";
333             }
334         }
335         elsif (
336             ( $linefilter[0] )
337             and (  ( $line =~ /closedate/ )
338                 or ( $line =~ /received/ ))
339           )
340         {
341             $strsth .= " AND $line >= ? ";
342         }
343         elsif ( $linefilter[0] ) {
344             $linefilter[0] =~ s/\*/%/g;
345             $strsth .= " AND $line LIKE ? ";
346         }
347     }
348     $strsth .= " GROUP BY $linefield";
349     $strsth .= " ORDER BY $line";
350
351     my $sth = $dbh->prepare($strsth);
352     if ( (@linefilter) and ( $linefilter[1] ) ) {
353         $sth->execute( $linefilter[0], $linefilter[1] );
354     }
355     elsif ( $linefilter[0] ) {
356         $sth->execute( $linefilter[0] );
357     }
358     else {
359         $sth->execute;
360     }
361     while ( my ($celvalue) = $sth->fetchrow ) {
362         my %cell;
363         if ($celvalue) {
364             $cell{rowtitle} = $celvalue;
365             push @loopline, \%cell;
366         }
367         $cell{totalrow} = 0;
368     }
369
370     # 2nd, loop cols.
371     my $strsth2 = "
372         SELECT DISTINCTROW $colfield
373         FROM aqorders
374           LEFT JOIN aqbasket ON (aqorders.basketno = aqbasket.basketno)
375           LEFT JOIN aqorders_items ON (aqorders.ordernumber = aqorders_items.ordernumber)
376           LEFT JOIN items ON (aqorders_items.itemnumber = items.itemnumber)
377           LEFT JOIN biblioitems ON (aqorders.biblionumber = biblioitems.biblionumber)
378           LEFT JOIN aqbudgets  ON (aqorders.budget_id = aqbudgets.budget_id )
379           LEFT JOIN aqbooksellers ON (aqbasket.booksellerid = aqbooksellers.id)
380         WHERE $column IS NOT NULL AND $column <> ''
381     ";
382
383     if (@colfilter) {
384         if ( $colfilter[1] ) {
385             if ( $colfilter[0] ) {
386                 $strsth2 .= " AND $column BETWEEN  ? AND ? ";
387             }
388             else {
389                 $strsth2 .= " AND $column <= ? ";
390             }
391         }
392         elsif (
393             ( $colfilter[0] )
394             and (  ( $column =~ /closedate/ )
395                 or ( $line =~ /received/ ))
396           )
397         {
398             $strsth2 .= " AND $column >= ? ";
399         }
400         elsif ( $colfilter[0] ) {
401             $colfilter[0] =~ s/\*/%/g;
402             $strsth2 .= " AND $column LIKE ? ";
403         }
404     }
405
406     $strsth2 .= " GROUP BY $colfield";
407     $strsth2 .= " ORDER BY $colfield";
408
409     my $sth2 = $dbh->prepare($strsth2);
410
411     if ( (@colfilter) and ($colfilter[1]) ) {
412         $sth2->execute( $colfilter[0], $colfilter[1] );
413     }
414     elsif ( $colfilter[0] ) {
415         $sth2->execute( $colfilter[0] );
416     }
417     else {
418         $sth2->execute;
419     }
420     while ( my $celvalue = $sth2->fetchrow ) {
421         my %cell;
422         if ($celvalue) {
423             $cell{coltitle} = $celvalue;
424             push @loopcol, \%cell;
425         }
426     }
427
428     my $i = 0;
429     my @totalcol;
430     my $hilighted = -1;
431
432     #Initialization of cell values.....
433     my %table;
434
435     foreach my $row (@loopline) {
436         foreach my $col (@loopcol) {
437             $table{ $row->{rowtitle} }->{ $col->{coltitle} } = 0;
438         }
439         $table{ $row->{rowtitle} }->{totalrow} = 0;
440     }
441
442     # preparing calculation
443     my $strcalc;
444     $strcalc .= "SELECT $linefield, $colfield, ";
445     if ( $process == 1 ) {
446         $strcalc .= "COUNT(*) ";
447     } elsif ( $process == 2 ) {
448         $strcalc .= "COUNT(DISTINCT(aqorders.biblionumber)) ";
449     } elsif ( $process == 3 || $process == 4 || $process == 5 ) {
450         $strcalc .= "SUM(aqorders.listprice) ";
451     } else {
452         $strcalc .= "NULL ";
453     }
454     $strcalc .= "
455         FROM aqorders
456           LEFT JOIN aqbasket ON (aqorders.basketno = aqbasket.basketno)
457           LEFT JOIN aqorders_items ON (aqorders.ordernumber = aqorders_items.ordernumber)
458           LEFT JOIN items ON (aqorders_items.itemnumber = items.itemnumber)
459           LEFT JOIN biblioitems ON (aqorders.biblionumber = biblioitems.biblionumber)
460           LEFT JOIN aqbudgets ON (aqorders.budget_id = aqbudgets.budget_id )
461           LEFT JOIN aqbooksellers ON (aqbasket.booksellerid = aqbooksellers.id)
462         WHERE aqorders.datecancellationprinted IS NULL ";
463     $strcalc .= " AND (aqorders.datereceived IS NULL OR aqorders.datereceived = '') "
464         if ( $process == 4 );
465     $strcalc .= " AND aqorders.datereceived IS NOT NULL AND aqorders.datereceived <> '' "
466         if ( $process == 5 );
467     @$filters[0] =~ s/\*/%/g if ( @$filters[0] );
468     $strcalc .= " AND aqbasket.closedate >= '" . @$filters[0] . "'"
469       if ( @$filters[0] );
470     @$filters[1] =~ s/\*/%/g if ( @$filters[1] );
471     $strcalc .= " AND aqbasket.closedate <= '" . @$filters[1] . "'"
472       if ( @$filters[1] );
473     @$filters[2] =~ s/\*/%/g if ( @$filters[2] );
474     $strcalc .= " AND aqorders.datereceived >= '" . @$filters[2] . "'"
475       if ( @$filters[2] );
476     @$filters[3] =~ s/\*/%/g if ( @$filters[3] );
477     $strcalc .= " AND aqorders.datereceived <= '" . @$filters[3] . "'"
478       if ( @$filters[3] );
479     @$filters[4] =~ s/\*/%/g if ( @$filters[4] );
480     $strcalc .= " AND aqbooksellers.name LIKE '" . @$filters[4] . "'"
481       if ( @$filters[4] );
482     $strcalc .= " AND items.homebranch = '" . @$filters[5] . "'"
483       if ( @$filters[5] );
484     @$filters[6] =~ s/\*/%/g if ( @$filters[6] );
485     $strcalc .= " AND items.ccode = '" . @$filters[6] . "'"
486       if ( @$filters[6] );
487     @$filters[7] =~ s/\*/%/g if ( @$filters[7] );
488     $strcalc .= " AND biblioitems.itemtype LIKE '" . @$filters[7] . "'"
489       if ( @$filters[7] );
490     @$filters[8] =~ s/\*/%/g if ( @$filters[8] );
491     $strcalc .= " AND aqbudgets.budget_code LIKE '" . @$filters[8] . "'"
492       if ( @$filters[8] );
493     @$filters[9] =~ s/\*/%/g if ( @$filters[9] );
494     $strcalc .= " AND aqorders.sort1 LIKE '" . @$filters[9] . "'"
495       if ( @$filters[9] );
496     @$filters[10] =~ s/\*/%/g if ( @$filters[10] );
497     $strcalc .= " AND aqorders.sort2 LIKE '" . @$filters[10] . "'"
498       if ( @$filters[10] );
499
500     $strcalc .= " GROUP BY $linefield, $colfield ORDER BY $linefield,$colfield";
501     my $dbcalc = $dbh->prepare($strcalc);
502     $dbcalc->execute;
503
504     my $emptycol;
505     while ( my ( $row, $col, $value ) = $dbcalc->fetchrow ) {
506         $emptycol = 1         if ( !defined($col) );
507         $col      = "zzEMPTY" if ( !defined($col) );
508         $row      = "zzEMPTY" if ( !defined($row) );
509
510         $table{$row}->{$col}     += $value;
511         $table{$row}->{totalrow} += $value;
512         $grantotal               += $value;
513     }
514
515     push @loopcol, { coltitle => "NULL" } if ($emptycol);
516
517     foreach my $row ( sort keys %table ) {
518         my @loopcell;
519         #@loopcol ensures the order for columns is common with column titles
520         # and the number matches the number of columns
521         foreach my $col (@loopcol) {
522             my $value = $table{$row}->{ ( $col->{coltitle} eq "NULL" ) ? "zzEMPTY" : $col->{coltitle} };
523             $value = sprintf("%.2f", $value) if($value and grep /$process/, (3,4,5));
524             push @loopcell, { value => $value };
525         }
526         my $r = {
527             rowtitle => ( $row eq "zzEMPTY" ) ? "NULL" : $row,
528             loopcell  => \@loopcell,
529             hilighted => ( $hilighted > 0 ),
530             totalrow  => $table{$row}->{totalrow}
531         };
532         $r->{totalrow} = sprintf("%.2f", $r->{totalrow}) if($r->{totalrow} and grep /$process/, (3,4,5));
533         push @looprow, $r;
534         $hilighted = -$hilighted;
535     }
536
537     foreach my $col (@loopcol) {
538         my $total = 0;
539         foreach my $row (@looprow) {
540             $total += $table{
541                 ( $row->{rowtitle} eq "NULL" ) ? "zzEMPTY"
542                 : $row->{rowtitle}
543               }->{
544                 ( $col->{coltitle} eq "NULL" ) ? "zzEMPTY"
545                 : $col->{coltitle}
546               };
547         }
548         $total = sprintf("%.2f", $total) if($total and grep /$process/, (3,4,5));
549
550         push @loopfooter, { 'totalcol' => $total };
551     }
552
553     # the header of the table
554     $globalline{loopfilter} = \@loopfilter;
555     # the core of the table
556     $globalline{looprow} = \@looprow;
557     $globalline{loopcol} = \@loopcol;
558
559     #       # the foot (totals by borrower type)
560     $grantotal = sprintf("%.2f", $grantotal) if ($grantotal and grep /$process/, (3,4,5));
561     $globalline{loopfooter} = \@loopfooter;
562     $globalline{total}      = $grantotal;
563     $globalline{line}       = $line;
564     $globalline{column}     = $column;
565     push @mainloop, \%globalline;
566     return \@mainloop;
567 }
568
569 1;
570