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