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