Bug 3420: Fixes 'Patrons with no checkouts' report.
[koha.git] / reports / borrowers_out.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 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;
22 use C4::Auth;
23 use C4::Context;
24 use C4::Koha;
25 use C4::Output;
26 use C4::Circulation;
27 use C4::Reports;
28 use C4::Members;
29 use C4::Dates qw/format_date_in_iso/;
30
31 =head1 NAME
32
33 plugin that shows a stats on borrowers
34
35 =head1 DESCRIPTION
36
37 =over 2
38
39 =cut
40
41 my $input = new CGI;
42 my $do_it=$input->param('do_it');
43 my $fullreportname = "reports/borrowers_out.tmpl";
44 my $limit = $input->param("Limit");
45 my $column = $input->param("Criteria");
46 my @filters = $input->param("Filter");
47 my $output = $input->param("output");
48 my $basename = $input->param("basename");
49 my $mime = $input->param("MIME");
50 our $sep     = $input->param("sep");
51 $sep = "\t" if ($sep eq 'tabulation');
52 my ($template, $borrowernumber, $cookie)
53     = get_template_and_user({template_name => $fullreportname,
54                 query => $input,
55                 type => "intranet",
56                 authnotrequired => 0,
57                 flagsrequired => {reports => 1},
58                 debug => 1,
59                 });
60 $template->param(do_it => $do_it,
61         DHTMLcalendar_dateformat => C4::Dates->DHTMLcalendar(),
62         );
63 if ($do_it) {
64 # Displaying results
65     my $results = calculate($limit, $column, \@filters);
66     if ($output eq "screen"){
67 # Printing results to screen
68         $template->param(mainloop => $results);
69         output_html_with_http_headers $input, $cookie, $template->output;
70         exit(1);
71     } else {
72 # Printing to a csv file
73         print $input->header(-type => 'application/vnd.sun.xml.calc',
74                             -encoding    => 'utf-8',
75                             -attachment=>"$basename.csv",
76                             -filename=>"$basename.csv" );
77         my $cols = @$results[0]->{loopcol};
78         my $lines = @$results[0]->{looprow};
79 # header top-right
80         print "num /". @$results[0]->{column} .$sep;
81 # Other header
82         foreach my $col ( @$cols ) {
83             print $col->{coltitle}.$sep;
84         }
85         print "Total\n";
86 # Table
87         foreach my $line ( @$lines ) {
88             my $x = $line->{loopcell};
89             print $line->{rowtitle}.$sep;
90             foreach my $cell (@$x) {
91                 print $cell->{value}.$sep;
92             }
93             print $line->{totalrow};
94             print "\n";
95         }
96 # footer
97         print "TOTAL";
98         $cols = @$results[0]->{loopfooter};
99         foreach my $col ( @$cols ) {
100             print $sep.$col->{totalcol};
101         }
102         print $sep.@$results[0]->{total};
103         exit(1);
104     }
105 # Displaying choices
106 } else {
107     my $dbh = C4::Context->dbh;
108     my @values;
109     my %labels;
110     my %select;
111     my $req;
112     
113     my @mime = ( C4::Context->preference("MIME") );
114 #       foreach my $mime (@mime){
115 #               warn "".$mime;
116 #       }
117     
118     my $CGIextChoice=CGI::scrolling_list(
119                 -name     => 'MIME',
120                 -id       => 'MIME',
121                 -values   => \@mime,
122                 -size     => 1,
123                 -multiple => 0 );
124     
125         my $CGIsepChoice = GetDelimiterChoices;
126     
127     my ($codes,$labels) = GetborCatFromCatType(undef,undef);
128     my @borcatloop;
129     foreach my $thisborcat (sort keys %$labels) {
130             my %row =(value => $thisborcat,
131                                     description => $labels->{$thisborcat},
132                             );
133             push @borcatloop, \%row;
134     }
135     $template->param(
136                     CGIextChoice => $CGIextChoice,
137                     CGIsepChoice => $CGIsepChoice,
138                     borcatloop =>\@borcatloop,
139                     );
140 output_html_with_http_headers $input, $cookie, $template->output;
141 }
142
143
144 sub calculate {
145     my ($line, $column, $filters) = @_;
146     my @mainloop;
147     my @loopfooter;
148     my @loopcol;
149     my @loopline;
150     my @looprow;
151     my %globalline;
152     my $grantotal =0;
153 # extract parameters
154     my $dbh = C4::Context->dbh;
155
156 # Filters
157 # Checking filters
158 #
159     my @loopfilter;
160     for (my $i=0;$i<=2;$i++) {
161         my %cell;
162         if ( @$filters[$i] ) {
163             if (($i==1) and (@$filters[$i-1])) {
164                 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
165             }
166             $cell{filter} .= @$filters[$i];
167             $cell{crit} .="Bor Cat" if ($i==0);
168             $cell{crit} .="Without issues since" if ($i==1);
169             push @loopfilter, \%cell;
170         }
171     }
172     my $colfield;
173     my $colorder;
174     if ($column){
175         $column = "borrowers.".$column if $column=~/categorycode/ || $column=~/branchcode/;
176         my @colfilter ;
177         $colfilter[0] = @$filters[0] if ($column =~ /category/ )  ;
178     #   $colfilter[0] = @$filters[11] if ($column =~ /sort2/ ) ;
179     #warn "filtre col ".$colfilter[0]." ".$colfilter[1];
180                                                 
181     # loop cols.
182         $colfield .= $column;
183         $colorder .= $column;
184         
185         my $strsth2;
186         $strsth2 .= "select distinctrow $colfield FROM borrowers LEFT JOIN `old_issues` ON old_issues.borrowernumber=borrowers.borrowernumber";
187         if ($colfilter[0]) {
188             $colfilter[0] =~ s/\*/%/g;
189             $strsth2 .= " and $column LIKE '$colfilter[0]' " ;
190         }
191         $strsth2 .=" group by $colfield";
192         $strsth2 .=" order by $colorder";
193         warn "". $strsth2;
194         
195         my $sth2 = $dbh->prepare( $strsth2 );
196         $sth2->execute;
197
198         while (my ($celvalue) = $sth2->fetchrow) {
199             my %cell;
200     #           my %ft;
201     #           warn "coltitle :".$celvalue;
202             $cell{coltitle} = $celvalue;
203     #           $ft{totalcol} = 0;
204             push @loopcol, \%cell;
205         }
206     #   warn "fin des titres colonnes";
207     }
208     
209     my $i=0;
210 #       my @totalcol;
211     
212     #Initialization of cell values.....
213     my @table;
214     
215 #       warn "init table";
216     for (my $i=1;$i<=$line;$i++) {
217         foreach my $col ( @loopcol ) {
218 #                       warn " init table : $row->{rowtitle} / $col->{coltitle} ";
219             $table[$i]->{($col->{coltitle})?$col->{coltitle}:"Global"}=0;
220         }
221     }
222
223
224 # preparing calculation
225     my $strcalc ;
226     
227 # Processing calculation
228     $strcalc .= "SELECT CONCAT( borrowers.surname , \"\\t\",borrowers.firstname, \"\\t\", borrowers.cardnumber)";
229     $strcalc .= " , $colfield " if ($colfield);
230     $strcalc .= " FROM borrowers ";
231     $strcalc .= "WHERE 1 ";
232     @$filters[0]=~ s/\*/%/g if (@$filters[0]);
233     $strcalc .= " AND borrowers.categorycode like '" . @$filters[0] ."'" if ( @$filters[0] );
234     if (@$filters[1]){
235         my $strqueryfilter="SELECT DISTINCT borrowernumber FROM old_issues where old_issues.timestamp> @$filters[1] ";
236 #        my $queryfilter = $dbh->prepare("SELECT DISTINCT borrowernumber FROM old_issues where old_issues.timestamp> ".format_date_in_iso(@$filters[1]));
237         $strcalc .= " AND borrowers.borrowernumber not in ($strqueryfilter)";
238         
239 #               $queryfilter->execute(@$filters[1]);
240 #               while (my ($borrowernumber)=$queryfilter->fetchrow){
241 #                       $strcalc .= " AND borrowers.borrowernumber <> $borrowernumber ";
242 #               }
243     } else {
244         my $strqueryfilter="SELECT DISTINCT borrowernumber FROM old_issues ";
245 #        my $queryfilter = $dbh->prepare("SELECT DISTINCT borrowernumber FROM old_issues ");
246 #        $queryfilter->execute;
247         $strcalc .= " AND borrowers.borrowernumber not in ($strqueryfilter)";
248 #               while (my ($borrowernumber)=$queryfilter->fetchrow){
249 #                       $strcalc .= " AND borrowers.borrowernumber <> $borrowernumber ";
250 #               }
251     }
252     $strcalc .= " group by borrowers.borrowernumber";
253     $strcalc .= ", $colfield" if ($column);
254     $strcalc .= " order by $colfield " if ($colfield);
255     my $max;
256     if (@loopcol) {
257         $max = $line*@loopcol;
258     } else { $max=$line;}
259     $strcalc .= " LIMIT 0,$max" if ($line);
260     warn "SQL :". $strcalc;
261     
262     my $dbcalc = $dbh->prepare($strcalc);
263     $dbcalc->execute;
264 #       warn "filling table";
265     my $previous_col;
266     $i=1;
267     while (my  @data = $dbcalc->fetchrow) {
268         my ($row, $col )=@data;
269         $col = "zzEMPTY" if (!defined($col));
270         $i=1 if (($previous_col) and not($col eq $previous_col));
271         $table[$i]->{$col}=$row;
272 #               warn " $i $col $row";
273         $i++;
274         $previous_col=$col;
275     }
276     
277     push @loopcol,{coltitle => "Global"} if not($column);
278     
279     $max =(($line)?$line:@table -1);
280     for ($i=1; $i<=$max;$i++) {
281         my @loopcell;
282         #@loopcol ensures the order for columns is common with column titles
283         # and the number matches the number of columns
284         my $colcount=0;
285         foreach my $col ( @loopcol ) {
286             my $value;
287             if (@loopcol){
288                 $value =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}};
289             } else {
290                 $value =$table[$i]->{"zzEMPTY"};
291             }
292             push @loopcell, {value => $value} ;
293         }
294         push @looprow,{ 'rowtitle' => $i ,
295                         'loopcell' => \@loopcell,
296                     };
297     }
298     
299             
300
301     # the header of the table
302     $globalline{loopfilter}=\@loopfilter;
303     # the core of the table
304     $globalline{looprow} = \@looprow;
305     $globalline{loopcol} = \@loopcol;
306 #       # the foot (totals by borrower type)
307     $globalline{loopfooter} = \@loopfooter;
308     $globalline{total}= $grantotal;
309     $globalline{line} = $line;
310     $globalline{column} = $column;
311     push @mainloop,\%globalline;
312     return \@mainloop;
313 }
314
315 1;