4 # Copyright 2000-2002 Katipo Communications
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use C4::Auth qw( get_template_and_user );
25 use C4::Output qw( output_html_with_http_headers );
26 use C4::Koha qw( GetAuthorisedValues );
27 use C4::Reports qw( GetDelimiterChoices );
28 use Koha::DateUtils qw( dt_from_string output_pref );
33 plugin that shows a stats on borrowers
40 my $do_it=$input->param('do_it');
41 my $fullreportname = "reports/cat_issues_top.tt";
42 my $limit = $input->param("Limit");
43 my $column = $input->param("Criteria");
44 my @filters = $input->multi_param("Filter");
45 foreach ( @filters[0..3] ) {
46 $_ and $_ = eval { output_pref( { dt => dt_from_string ( $_ ), dateonly => 1, dateformat => 'iso' } ); };
49 my $output = $input->param("output");
50 my $basename = $input->param("basename");
51 #warn "calcul : ".$calc;
52 my ($template, $borrowernumber, $cookie)
53 = get_template_and_user({template_name => $fullreportname,
56 flagsrequired => { reports => '*'},
58 our $sep = $input->param("sep");
59 $sep = "\t" if ($sep eq 'tabulation');
60 $template->param(do_it => $do_it,
64 my $results = calculate($limit, $column, \@filters);
65 if ($output eq "screen"){
66 # Printing results to screen
67 $template->param(mainloop => $results,
69 output_html_with_http_headers $input, $cookie, $template->output;
72 # Printing to a csv file
73 print $input->header(-type => 'application/vnd.sun.xml.calc',
75 -attachment=>"$basename.csv",
76 -filename=>"$basename.csv" );
77 my $cols = @$results[0]->{loopcol};
78 my $lines = @$results[0]->{looprow};
80 print @$results[0]->{line} ."/". @$results[0]->{column} .$sep;
82 foreach my $col ( @$cols ) {
83 print $col->{coltitle}.$sep;
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 print $cell->{count} // '';
100 my $dbh = C4::Context->dbh;
102 my $CGIextChoice = ( 'CSV' ); # FIXME translation
103 my $CGIsepChoice=GetDelimiterChoices;
106 my $itemtypes = Koha::ItemTypes->search_with_localization;
109 my $ccodes = GetAuthorisedValues('CCODE');
111 for my $thisccode (@$ccodes) {
112 my %row = (value => $thisccode->{authorised_value},
113 description => $thisccode->{lib},
115 push @ccodeloop, \%row;
118 @ccodeloop = sort {$a->{value} cmp $b->{value}} @ccodeloop;
121 my $shelvinglocs = GetAuthorisedValues('LOC');
123 for my $thisloc (@$shelvinglocs) {
124 my %row = (value => $thisloc->{authorised_value},
125 description => $thisloc->{lib},
127 push @shelvinglocloop, \%row;
130 @shelvinglocloop = sort {$a->{value} cmp $b->{value}} @shelvinglocloop;
132 my $patron_categories = Koha::Patron::Categories->search_with_library_limits({}, {order_by => ['categorycode']});
135 CGIextChoice => $CGIextChoice,
136 CGIsepChoice => $CGIsepChoice,
137 itemtypes => $itemtypes,
138 ccodeloop =>\@ccodeloop,
139 shelvinglocloop =>\@shelvinglocloop,
140 patron_categories => $patron_categories,
142 output_html_with_http_headers $input, $cookie, $template->output;
149 my ($line, $column, $filters) = @_;
156 my $dbh = C4::Context->dbh;
162 for (my $i=0;$i<=12;$i++) {
164 if ( @$filters[$i] ) {
165 if (($i==1) and (@$filters[$i-1])) {
166 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
168 # format the dates filters, otherwise just fill as is
170 $cell{filter} .= @$filters[$i];
172 $cell{filter} .= eval { output_pref( { dt => dt_from_string( @$filters[$i] ), dateonly => 1 }); }
173 if ( @$filters[$i] );
175 $cell{crit} .="Issue From" if ($i==0);
176 $cell{crit} .="Issue To" if ($i==1);
177 $cell{crit} .="Return From" if ($i==2);
178 $cell{crit} .="Return To" if ($i==3);
179 $cell{crit} .="Branch" if ($i==4);
180 $cell{crit} .="Doc Type" if ($i==5);
181 $cell{crit} .="Call number" if ($i==6);
182 $cell{crit} .="Collection code" if ($i==7);
183 $cell{crit} .="Shelving location" if ($i==8);
184 $cell{crit} .="Bor Cat" if ($i==9);
185 $cell{crit} .="Day" if ($i==10);
186 $cell{crit} .="Month" if ($i==11);
187 $cell{crit} .="Year" if ($i==12);
188 push @loopfilter, \%cell;
194 $column = "old_issues.".$column if (($column=~/branchcode/) or ($column=~/issuedate/));
195 if($column=~/itemtype/){
196 $column = C4::Context->preference('item-level_itypes') ? "items.itype": "biblioitems.itemtype";
198 $column = "borrowers.".$column if $column=~/categorycode/;
200 $colfilter[0] = @$filters[0] if ($column =~ /issuedate/ ) ;
201 $colfilter[1] = @$filters[1] if ($column =~ /issuedate/ ) ;
202 $colfilter[0] = @$filters[2] if ($column =~ /returndate/ ) ;
203 $colfilter[1] = @$filters[3] if ($column =~ /returndate/ ) ;
204 $colfilter[0] = @$filters[4] if ($column =~ /branch/ ) ;
205 $colfilter[0] = @$filters[5] if ($column =~ /itemtype/ ) ;
206 # These limits does not currently exist, maybe later?
207 # $colfilter[0] = @$filters[6] if ($column =~ /ccode/ ) ;
208 # $colfilter[0] = @$filters[7] if ($column =~ /location/ ) ;
209 $colfilter[0] = @$filters[8] if ($column =~ /category/ ) ;
210 # This commented out row (sort2) was not removed when adding new filters for ccode, shelving location and call number
211 # $colfilter[0] = @$filters[11] if ($column =~ /sort2/ ) ;
212 $colfilter[0] = @$filters[9] if ($column =~ /issuedate/ ) ;
213 $colfilter[0] = @$filters[10] if ($column =~ /issuedate/ ) ;
214 $colfilter[0] = @$filters[11] if ($column =~ /issuedate/ ) ;
215 #warn "filtre col ".$colfilter[0]." ".$colfilter[1];
218 if ($column eq "Day") {
220 $column = "old_issues.issuedate";
221 $colfield .="dayname($column)";
222 $colorder .="weekday($column)";
223 } elsif ($column eq "Month") {
225 $column = "old_issues.issuedate";
226 $colfield .="monthname($column)";
227 $colorder .="month($column)";
228 } elsif ($column eq "Year") {
230 $column = "old_issues.issuedate";
231 $colfield .="Year($column)";
232 $colorder .= $column;
234 $colfield .= $column;
235 $colorder .= $column;
239 $strsth2 .= "SELECT distinctrow $colfield
241 LEFT JOIN borrowers ON borrowers.borrowernumber=old_issues.borrowernumber
242 LEFT JOIN items ON old_issues.itemnumber=items.itemnumber
243 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber=items.biblioitemnumber
245 if (($column=~/issuedate/) or ($column=~/returndate/)){
246 if ($colfilter[1] and ($colfilter[0])){
247 $strsth2 .= " and $column between '$colfilter[0]' and '$colfilter[1]' " ;
248 } elsif ($colfilter[1]) {
249 $strsth2 .= " and $column < '$colfilter[1]' " ;
250 } elsif ($colfilter[0]) {
251 $strsth2 .= " and $column > '$colfilter[0]' " ;
253 } elsif ($colfilter[0]) {
254 $colfilter[0] =~ s/\*/%/g;
255 $strsth2 .= " and $column LIKE '$colfilter[0]' " ;
257 $strsth2 .=" group by $colfield";
258 $strsth2 .=" order by $colorder";
260 my $sth2 = $dbh->prepare( $strsth2 );
261 if (( @colfilter ) and ($colfilter[1])){
262 $sth2->execute("'".$colfilter[0]."'","'".$colfilter[1]."'");
263 } elsif ($colfilter[0]) {
264 $sth2->execute($colfilter[0]);
270 while (my ($celvalue) = $sth2->fetchrow) {
272 $cell{coltitle} = ($celvalue?$celvalue:"NULL");
273 push @loopcol, \%cell;
275 # warn "fin des titres colonnes";
282 #Initialization of cell values.....
286 for (my $i=1;$i<=$line;$i++) {
287 foreach my $col ( @loopcol ) {
288 # warn " init table : $row->{rowtitle} / $col->{coltitle} ";
289 $table[$i]->{($col->{coltitle})?$col->{coltitle}:"total"}->{'name'}=0;
294 # preparing calculation
297 # Processing average loanperiods
298 $strcalc .= "SELECT DISTINCT biblio.title, COUNT(biblio.biblionumber) AS `RANK`, biblio.biblionumber AS ID";
299 $strcalc .= ", itemcallnumber as CALLNUM";
300 $strcalc .= ", ccode as CCODE";
301 $strcalc .= ", location as LOC";
302 $strcalc .= " , $colfield " if ($colfield);
303 $strcalc .= " FROM `old_issues`
304 LEFT JOIN items USING(itemnumber)
305 LEFT JOIN biblio USING(biblionumber)
306 LEFT JOIN biblioitems USING(biblionumber)
307 LEFT JOIN borrowers USING(borrowernumber)
310 @$filters[0]=~ s/\*/%/g if (@$filters[0]);
311 $strcalc .= " AND old_issues.issuedate > '" . @$filters[0] ."'" if ( @$filters[0] );
312 @$filters[1]=~ s/\*/%/g if (@$filters[1]);
313 $strcalc .= " AND old_issues.issuedate < '" . @$filters[1] ."'" if ( @$filters[1] );
314 @$filters[2]=~ s/\*/%/g if (@$filters[2]);
315 $strcalc .= " AND old_issues.returndate > '" . @$filters[2] ."'" if ( @$filters[2] );
316 @$filters[3]=~ s/\*/%/g if (@$filters[3]);
317 $strcalc .= " AND old_issues.returndate < '" . @$filters[3] ."'" if ( @$filters[3] );
318 @$filters[4]=~ s/\*/%/g if (@$filters[4]);
319 $strcalc .= " AND old_issues.branchcode like '" . @$filters[4] ."'" if ( @$filters[4] );
320 @$filters[5]=~ s/\*/%/g if (@$filters[5]);
322 if(C4::Context->preference('item-level_itypes') ){
323 $strcalc .= " AND items.itype like "
325 $strcalc .= " AND biblioitems.itemtype like "
327 $strcalc .= "'" . @$filters[5] ."'" ;
329 @$filters[6]=~ s/\*/%/g if (@$filters[6]);
330 $strcalc .= " AND itemcallnumber like '" . @$filters[6] ."'" if ( @$filters[6] );
331 @$filters[7]=~ s/\*/%/g if (@$filters[7]);
332 $strcalc .= " AND ccode like '" . @$filters[7] ."'" if ( @$filters[7] );
333 @$filters[8]=~ s/\*/%/g if (@$filters[8]);
334 $strcalc .= " AND location like '" . @$filters[8] ."'" if ( @$filters[8] );
335 @$filters[9]=~ s/\*/%/g if (@$filters[9]);
336 $strcalc .= " AND borrowers.categorycode like '" . @$filters[9] ."'" if ( @$filters[9] );
337 @$filters[10]=~ s/\*/%/g if (@$filters[10]);
338 $strcalc .= " AND dayname(old_issues.issuedate) like '" . @$filters[10]."'" if (@$filters[10]);
339 @$filters[11]=~ s/\*/%/g if (@$filters[11]);
340 $strcalc .= " AND monthname(old_issues.issuedate) like '" . @$filters[11]."'" if (@$filters[11]);
341 @$filters[12]=~ s/\*/%/g if (@$filters[12]);
342 $strcalc .= " AND year(old_issues.issuedate) like '" . @$filters[12] ."'" if ( @$filters[12] );
344 $strcalc .= " group by biblio.biblionumber";
345 $strcalc .= ", $colfield" if ($column);
346 $strcalc .= " order by `RANK` DESC";
347 $strcalc .= ", $colfield " if ($colfield);
349 my $dbcalc = $dbh->prepare($strcalc);
352 while (my @data = $dbcalc->fetchrow) {
353 my ($row, $rank, $id, $callnum, $ccode, $loc, $col )=@data;
354 $col = "zzEMPTY" if (!defined($col));
355 $indice{$col}=1 if (not($indice{$col}));
356 $table[$indice{$col}]->{$col}->{'name'}=$row;
357 $table[$indice{$col}]->{$col}->{'count'}=$rank;
358 $table[$indice{$col}]->{$col}->{'link'}=$id;
362 push @loopcol,{coltitle => "Global"} if not($column);
364 for ($i=1; $i<=$line;$i++) {
366 #@loopcol ensures the order for columns is common with column titles
367 # and the number matches the number of columns
369 foreach my $col ( @loopcol ) {
374 $value =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'name'};
375 $count =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'count'};
376 $link =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'link'};
378 $value =$table[$i]->{"zzEMPTY"}->{'name'};
379 $count =$table[$i]->{"zzEMPTY"}->{'count'};
380 $link =$table[$i]->{"zzEMPTY"}->{'link'};
382 push @loopcell, {value => $value, count =>$count, reference => $link} ;
384 #my $total = $table[$i]->{totalrow}/$colcount if ($colcount>0);
385 push @looprow,{ 'rowtitle' => $i ,
386 'loopcell' => \@loopcell,
387 'hilighted' => ($hilighted >0),
389 $hilighted = -$hilighted;
394 # the header of the table
395 $globalline{loopfilter}=\@loopfilter;
396 # the core of the table
397 $globalline{looprow} = \@looprow;
398 $globalline{loopcol} = \@loopcol;
399 # # the foot (totals by borrower type)
400 $globalline{total}= $grantotal;
401 $globalline{line} = $line;
402 $globalline{column} = $column;
403 push @mainloop,\%globalline;