3 # Copyright 2010 BibLibre
5 # This file is part of Koha.
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
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.
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.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
27 use C4
::Branch
; # GetBranches
34 use List
::MoreUtils qw
/any/;
39 plugin that shows circulation stats
47 # my $debug = 1; # override for now.
49 my $fullreportname = "reports/reserves_stats.tt";
50 my $do_it = $input->param('do_it');
51 my $line = $input->param("Line");
52 my $column = $input->param("Column");
53 my $calc = $input->param("Cellvalue");
54 my $output = $input->param("output");
55 my $basename = $input->param("basename");
56 my $hash_params = $input->Vars;
58 foreach my $filter (grep {$_ =~/^filter/} keys %$hash_params){
59 my $filterstring=$filter;
60 $filterstring=~s/^filter_//g;
61 $$filter_hashref{$filterstring}=$$hash_params{$filter} if (defined $$hash_params{$filter} && $$hash_params{$filter} ne "");
63 my ($template, $borrowernumber, $cookie) = get_template_and_user
({
64 template_name
=> $fullreportname,
68 flagsrequired
=> {reports
=> '*'},
71 our $sep = $input->param("sep") || '';
72 $sep = "\t" if ($sep eq 'tabulation');
73 $template->param(do_it
=> $do_it,
76 my $itemtypes = GetItemTypes
();
77 my $categoryloop = GetBorrowercategoryList
;
79 my $ccodes = GetKohaAuthorisedValues
("items.ccode");
80 my $locations = GetKohaAuthorisedValues
("items.location");
81 my $authvalue = GetKohaAuthorisedValues
("items.authvalue");
83 my $Bsort1 = GetAuthorisedValues
("Bsort1");
84 my $Bsort2 = GetAuthorisedValues
("Bsort2");
85 my ($hassort1,$hassort2);
86 $hassort1=1 if $Bsort1;
87 $hassort2=1 if $Bsort2;
92 my $results = calculate
($line, $column, $calc, $filter_hashref);
93 if ($output eq "screen"){
94 # Printing results to screen
95 $template->param(mainloop
=> $results);
96 output_html_with_http_headers
$input, $cookie, $template->output;
98 # Printing to a csv file
99 print $input->header(-type
=> 'application/vnd.sun.xml.calc',
100 -encoding
=> 'utf-8',
101 -attachment
=>"$basename.csv",
102 -filename
=>"$basename.csv" );
103 my $cols = @
$results[0]->{loopcol
};
104 my $lines = @
$results[0]->{looprow
};
106 print @
$results[0]->{line
} ."/". @
$results[0]->{column
} .$sep;
108 foreach my $col ( @
$cols ) {
109 print $col->{coltitle
}.$sep;
113 foreach my $line ( @
$lines ) {
114 my $x = $line->{loopcell
};
115 print $line->{rowtitle
}.$sep;
116 print map {$_->{value
}.$sep} @
$x;
117 print $line->{totalrow
}, "\n";
121 $cols = @
$results[0]->{loopfooter
};
122 print map {$sep.$_->{totalcol
}} @
$cols;
123 print $sep.@
$results[0]->{total
};
125 exit; # exit either way after $do_it
128 my $dbh = C4
::Context
->dbh;
133 # create itemtype arrayref for <select>.
135 for my $itype ( sort {$itemtypes->{$a}->{translated_description
} cmp $itemtypes->{$b}->{translated_description
}} keys(%$itemtypes)) {
136 push @itemtypeloop, { code
=> $itype , description
=> $itemtypes->{$itype}->{translated_description
} } ;
141 foreach (sort keys %$locations) {
142 push @locations, { code
=> $_, description
=> "$_ - " . $locations->{$_} };
146 foreach (sort {$ccodes->{$a} cmp $ccodes->{$b}} keys %$ccodes) {
147 push @ccodes, { code
=> $_, description
=> $ccodes->{$_} };
151 my $CGIextChoice = ( 'CSV' ); # FIXME translation
152 my $CGIsepChoice=GetDelimiterChoices
;
155 categoryloop
=> $categoryloop,
156 itemtypeloop
=> \
@itemtypeloop,
157 locationloop
=> \
@locations,
158 ccodeloop
=> \
@ccodes,
159 branchloop
=> GetBranchesLoop
(C4
::Context
->userenv->{'branch'}),
160 hassort1
=> $hassort1,
161 hassort2
=> $hassort2,
164 CGIextChoice
=> $CGIextChoice,
165 CGIsepChoice
=> $CGIsepChoice,
167 output_html_with_http_headers
$input, $cookie, $template->output;
170 my ($linefield, $colfield, $process, $filters_hashref) = @_;
178 my $dbh = C4
::Context
->dbh;
184 foreach my $filter ( keys %$filters_hashref ) {
185 $filters_hashref->{$filter} =~ s/\*/%/;
186 if ( $filter =~ /date/ ) {
187 $filters_hashref->{$filter} =
188 eval { output_pref
( { dt
=> dt_from_string
( $filters_hashref->{$filter} ), dateonly
=> 1, dateformat
=> 'iso' }); };
198 ?
eval { output_pref
( { dt
=> dt_from_string
( $filters_hashref->{$_} ), dateonly
=> 1 }); }
199 : $filters_hashref->{$_}
202 } sort keys %$filters_hashref;
207 my $linesql=changeifreservestatus
($linefield);
208 my $colsql=changeifreservestatus
($colfield);
209 #Initialization of cell values.....
211 # preparing calculation
212 my $strcalc = "(SELECT $linesql line, $colsql col, ";
213 $strcalc .= ($process == 1) ?
" COUNT(*) calculation" :
214 ($process == 2) ?
"(COUNT(DISTINCT reserves.borrowernumber)) calculation" :
215 ($process == 3) ?
"(COUNT(DISTINCT reserves.itemnumber)) calculation" :
216 ($process == 4) ?
"(COUNT(DISTINCT reserves.biblionumber)) calculation" : '*';
219 LEFT JOIN borrowers USING (borrowernumber)
221 $strcalc .= "LEFT JOIN biblio ON reserves.biblionumber=biblio.biblionumber "
222 if ($linefield =~ /^biblio\./ or $colfield =~ /^biblio\./ or any
{$_=~/biblio/}keys %$filters_hashref);
223 $strcalc .= "LEFT JOIN items ON reserves.itemnumber=items.itemnumber "
224 if ($linefield =~ /^items\./ or $colfield =~ /^items\./ or any
{$_=~/items/}keys %$filters_hashref);
230 ($debug) and print STDERR Dump
($filters_hashref);
231 foreach my $filter (keys %$filters_hashref){
233 my $stringfield=$filter;
234 $stringfield=~s/\_[a-z_]+$//;
236 $string=$stringfield;
238 elsif ($filter=~/_or/){
239 push @sqlor, qq{( }.changeifreservestatus
($filter)." = ? ) ";
240 push @sqlorparams, $$filters_hashref{$filter};
242 elsif ($filter=~/_endex$/){
243 $string = " $stringfield < ? ";
245 elsif ($filter=~/_end$/){
246 $string = " $stringfield <= ? ";
248 elsif ($filter=~/_begin$/){
249 $string = " $stringfield >= ? ";
252 $string = " $stringfield LIKE ? ";
255 push @sqlwhere, $string;
256 push @sqlparams, $$filters_hashref{$filter};
260 $strcalc .= " WHERE ".join(" AND ",@sqlwhere) if (@sqlwhere);
261 $strcalc .= " AND (".join(" OR ",@sqlor).")" if (@sqlor);
262 $strcalc .= " GROUP BY line, col )";
263 my $strcalc_old=$strcalc;
264 $strcalc_old=~s/reserves/old_reserves/g;
265 $strcalc.=qq{ UNION
$strcalc_old ORDER BY line
, col
};
266 ($debug) and print STDERR
$strcalc;
267 my $dbcalc = $dbh->prepare($strcalc);
268 push @loopfilter, {crit
=>'SQL =', sql
=>1, filter
=>$strcalc};
269 @sqlparams=(@sqlparams,@sqlorparams);
270 $dbcalc->execute(@sqlparams,@sqlparams);
271 my ($emptycol,$emptyrow);
272 my $data = $dbcalc->fetchall_hashref([qw(line col)]);
274 foreach my $row (keys %$data){
275 push @loopline, $row;
276 foreach my $col (keys %{$$data{$row}}){
277 $$data{$row}{totalrow
}+=$$data{$row}{$col}{calculation
};
278 $grantotal+=$$data{$row}{$col}{calculation
};
282 my $urlbase="do_it=1&".join("&",map{"filter_$_=$$filters_hashref{$_}"} keys %$filters_hashref);
283 foreach my $row (sort @loopline) {
285 #@loopcol ensures the order for columns is common with column titles
286 # and the number matches the number of columns
287 foreach my $col (sort keys %cols_hash) {
288 push @loopcell, {value
=>( $$data{$row}{$col}{calculation
} or ""),
289 # url_complement=>($urlbase=~/&$/?$urlbase."&":$urlbase)."filter_$linefield=$row&filter_$colfield=$col"
293 'rowtitle_display' => display_value
($linefield,$row),
295 'loopcell' => \
@loopcell,
296 'totalrow' => $$data{$row}{totalrow
}
299 for my $col ( sort keys %cols_hash ) {
301 foreach my $row (@loopline) {
302 $total += $data->{$row}{$col}{calculation
} if $data->{$row}{$col}{calculation
};
303 $debug and warn "value added ".$$data{$row}{$col}{calculation
}. "for line ".$row;
305 push @loopfooter, {'totalcol' => $total};
306 push @loopcol, {'coltitle' => $col,
307 coltitle_display
=>display_value
($colfield,$col)};
309 # the header of the table
310 $globalline{loopfilter
}=\
@loopfilter;
311 # the core of the table
312 $globalline{looprow
} = \
@looprow;
313 $globalline{loopcol
} = \
@loopcol;
314 # # the foot (totals by borrower type)
315 $globalline{loopfooter
} = \
@loopfooter;
316 $globalline{total
} = $grantotal;
317 $globalline{line
} = $linefield;
318 $globalline{column
} = $colfield;
319 return [(\
%globalline)];
323 my ( $crit, $value ) = @_;
324 my $ccodes = GetKohaAuthorisedValues
("items.ccode");
325 my $locations = GetKohaAuthorisedValues
("items.location");
326 my $itemtypes = GetItemTypes
();
327 my $authvalue = GetKohaAuthorisedValues
("items.authvalue");
328 my $Bsort1 = GetAuthorisedValues
("Bsort1");
329 my $Bsort2 = GetAuthorisedValues
("Bsort2");
331 ( $crit =~ /ccode/ ) ?
$ccodes->{$value}
332 : ( $crit =~ /location/ ) ?
$locations->{$value}
333 : ( $crit =~ /itemtype/ ) ?
$itemtypes->{$value}->{description
}
334 : ( $crit =~ /branch/ ) ? GetBranchName
($value)
335 : ( $crit =~ /reservestatus/ ) ? reservestatushuman
($value)
336 : $value; # default fallback
337 if ($crit =~ /sort1/) {
339 ($value eq $_->{authorised_value
}) or next;
340 $display_value = $_->{lib
} and last;
343 elsif ($crit =~ /sort2/) {
345 ($value eq $_->{authorised_value
}) or next;
346 $display_value = $_->{lib
} and last;
349 elsif ( $crit =~ /category/ ) {
350 foreach (@
$categoryloop) {
351 ( $value eq $_->{categorycode
} ) or next;
352 $display_value = $_->{description
} and last;
355 return $display_value;
358 sub reservestatushuman
{
371 sub changeifreservestatus
{
373 ($val=~/reservestatus/
375 when priority
>0 then
1
378 when found
='f' then
4
381 when cancellationdate is null then
3