Fridolin Somers
9d8ddcc1b7
System preference 'CSVdelimiter' has a special case for tabulation.
Preference value contains string 'tabulation' but string '\t' must be used in CSV file.
This is OK in many places, for exemple Bug 17590.
This patch adds C4::Context->csv_delimiter to add a uniq metod dealing
with this behavior.
Also create Koha::Template::Plugin::Koha->CSVDelimiter for calls from
Toolkit Templates.
Test plan :
1) Set system preference 'CSVdelimiter' = 'tabs'.
2) Create CSV export in impacted pages
3) Check columns are separated by tabulation character and not string 'tabulation'
4) Check with another delimiter
Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
(cherry picked from commit 381b79593e)
Signed-off-by: Lucas Gass <lucas@bywatersolutions.com>
353 lines
11 KiB
Perl
Executable file
353 lines
11 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
# Copyright 2000-2002 Katipo Communications
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# Koha is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
|
|
use CGI qw ( -utf8 );
|
|
use C4::Auth qw( get_template_and_user );
|
|
use C4::Output qw( output_html_with_http_headers );
|
|
use C4::Context;
|
|
use C4::Reports qw( GetDelimiterChoices );
|
|
|
|
use Koha::DateUtils qw( dt_from_string output_pref );
|
|
use Koha::ItemTypes;
|
|
use Koha::Patron::Categories;
|
|
|
|
=head1 NAME
|
|
|
|
plugin that shows a stats on borrowers
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
=cut
|
|
|
|
my $input = CGI->new;
|
|
my $fullreportname = "reports/bor_issues_top.tt";
|
|
my $do_it = $input->param('do_it');
|
|
my $limit = $input->param("Limit");
|
|
my $column = $input->param("Criteria");
|
|
my @filters = $input->multi_param("Filter");
|
|
foreach ( @filters[0..3] ) {
|
|
$_ and $_ = eval { output_pref( { dt => dt_from_string ( $_ ), dateonly => 1, dateformat => 'iso' }); };
|
|
}
|
|
my $output = $input->param("output");
|
|
my $basename = $input->param("basename");
|
|
my ($template, $borrowernumber, $cookie)
|
|
= get_template_and_user({template_name => $fullreportname,
|
|
query => $input,
|
|
type => "intranet",
|
|
flagsrequired => {reports => '*'},
|
|
});
|
|
our $sep = C4::Context->csv_delimiter(scalar $input->param("sep"));
|
|
$template->param(do_it => $do_it,
|
|
);
|
|
if ($do_it) {
|
|
# Displaying results
|
|
my $results = calculate($limit, $column, \@filters);
|
|
if ($output eq "screen"){
|
|
# Printing results to screen
|
|
$template->param(mainloop => $results, limit=>$limit);
|
|
output_html_with_http_headers $input, $cookie, $template->output;
|
|
} else {
|
|
# Printing to a csv file
|
|
print $input->header(-type => 'application/vnd.sun.xml.calc',
|
|
-encoding => 'utf-8',
|
|
-attachment=>"$basename.csv",
|
|
-filename=>"$basename.csv" );
|
|
my $cols = @$results[0]->{loopcol};
|
|
my $lines = @$results[0]->{looprow};
|
|
# header top-right
|
|
print @$results[0]->{line} ."/". @$results[0]->{column} .$sep;
|
|
# Other header
|
|
print join($sep, map {$_->{coltitle}} @$cols);
|
|
print $sep . "Total\n";
|
|
# Table
|
|
foreach my $line ( @$lines ) {
|
|
my $x = $line->{loopcell};
|
|
print $line->{rowtitle}.$sep;
|
|
print join($sep, map {$_->{value}} @$x);
|
|
print $sep,$line->{totalrow};
|
|
print "\n";
|
|
}
|
|
# footer
|
|
print "TOTAL";
|
|
$cols = @$results[0]->{loopfooter};
|
|
print join($sep, map {$_->{totalcol}} @$cols);
|
|
print $sep.@$results[0]->{total};
|
|
}
|
|
exit;
|
|
}
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
|
|
# here each element returned by map is a hashref, get it?
|
|
my @mime = ( map { {type =>$_} } (split /[;:]/, 'CSV') ); # FIXME translation
|
|
my $delims = GetDelimiterChoices;
|
|
|
|
my $patron_categories = Koha::Patron::Categories->search_with_library_limits({}, {order_by => ['categorycode']});
|
|
my $itemtypes = Koha::ItemTypes->search_with_localization;
|
|
$template->param(
|
|
mimeloop => \@mime,
|
|
CGIseplist => $delims,
|
|
itemtypes => $itemtypes,
|
|
patron_categories => $patron_categories,
|
|
);
|
|
output_html_with_http_headers $input, $cookie, $template->output;
|
|
|
|
|
|
sub calculate {
|
|
my ($limit, $column, $filters) = @_;
|
|
|
|
my @loopcol;
|
|
my @looprow;
|
|
my %globalline;
|
|
my %columns;
|
|
my $grantotal =0;
|
|
my $dbh = C4::Context->dbh;
|
|
|
|
|
|
# Checking filters
|
|
my @loopfilter;
|
|
my @cellmap = (
|
|
"Issue From",
|
|
"Issue To",
|
|
"Return From",
|
|
"Return To",
|
|
"Branch",
|
|
"Doc Type",
|
|
"Bor Cat",
|
|
"Day",
|
|
"Month",
|
|
"Year"
|
|
);
|
|
for (my $i=0;$i<=6;$i++) {
|
|
my %cell;
|
|
if ( @$filters[$i] ) {
|
|
if (($i==1) and (@$filters[$i-1])) {
|
|
$cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
|
|
}
|
|
# format the dates filters, otherwise just fill as is
|
|
$cell{filter} .= @$filters[$i];
|
|
defined ($cellmap[$i]) and
|
|
$cell{crit} .= $cellmap[$i];
|
|
push @loopfilter, \%cell;
|
|
}
|
|
}
|
|
my $colfield;
|
|
my $colorder;
|
|
if ($column){
|
|
$column = "old_issues." .$column if (($column=~/branchcode/) or ($column=~/timestamp/));
|
|
$column = "biblioitems.".$column if $column=~/itemtype/;
|
|
$column = "borrowers." .$column if $column=~/categorycode/;
|
|
my @colfilter ;
|
|
if ($column =~ /timestamp/) {
|
|
$colfilter[0] = @$filters[0];
|
|
$colfilter[1] = @$filters[1];
|
|
} elsif ($column =~ /returndate/) {
|
|
$colfilter[0] = @$filters[2];
|
|
$colfilter[1] = @$filters[3];
|
|
} elsif ($column =~ /branchcode/) {
|
|
$colfilter[0] = @$filters[4];
|
|
} elsif ($column =~ /itemtype/) {
|
|
$colfilter[0] = @$filters[5];
|
|
} elsif ($column =~ /category/) {
|
|
$colfilter[0] = @$filters[6];
|
|
} elsif ($column =~ /sort2/ ) {
|
|
# $colfilter[0] = @$filters[11];
|
|
}
|
|
|
|
# loop cols.
|
|
if ($column eq "Day") {
|
|
#Display by day
|
|
$column = "old_issues.timestamp";
|
|
$colfield .="dayname($column)";
|
|
$colorder .="weekday($column)";
|
|
} elsif ($column eq "Month") {
|
|
#Display by Month
|
|
$column = "old_issues.timestamp";
|
|
$colfield .="monthname($column)";
|
|
$colorder .="month($column)";
|
|
} elsif ($column eq "Year") {
|
|
#Display by Year
|
|
$column = "old_issues.timestamp";
|
|
$colfield .="Year($column)";
|
|
$colorder .= $column;
|
|
} else {
|
|
$colfield .= $column;
|
|
$colorder .= $column;
|
|
}
|
|
|
|
my $strsth2;
|
|
$strsth2 .= "SELECT DISTINCTROW $colfield
|
|
FROM `old_issues`
|
|
LEFT JOIN borrowers ON old_issues.borrowernumber=borrowers.borrowernumber
|
|
LEFT JOIN items ON old_issues.itemnumber=items.itemnumber
|
|
LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
|
|
WHERE 1";
|
|
if (($column=~/timestamp/) or ($column=~/returndate/)){
|
|
if ($colfilter[1] and $colfilter[0]){
|
|
$strsth2 .= " AND $column between '$colfilter[0]' AND '$colfilter[1]' " ;
|
|
} elsif ($colfilter[1]) {
|
|
$strsth2 .= " AND $column < '$colfilter[1]' " ;
|
|
} elsif ($colfilter[0]) {
|
|
$strsth2 .= " AND $column > '$colfilter[0]' " ;
|
|
}
|
|
} elsif ($colfilter[0]) {
|
|
$colfilter[0] =~ s/\*/%/g;
|
|
$strsth2 .= " AND $column LIKE '$colfilter[0]' " ;
|
|
}
|
|
$strsth2 .=" GROUP BY $colfield";
|
|
$strsth2 .=" ORDER BY $colorder";
|
|
|
|
my $sth2 = $dbh->prepare($strsth2);
|
|
$sth2->execute;
|
|
while (my @row = $sth2->fetchrow) {
|
|
$columns{($row[0] ||'NULL')}++;
|
|
push @loopcol, { coltitle => $row[0] || 'NULL' };
|
|
}
|
|
|
|
$strsth2 =~ s/old_issues/issues/g;
|
|
$sth2 = $dbh->prepare($strsth2);
|
|
$sth2->execute;
|
|
while (my @row = $sth2->fetchrow) {
|
|
$columns{($row[0] ||'NULL')}++;
|
|
push @loopcol, { coltitle => $row[0] || 'NULL' };
|
|
}
|
|
}else{
|
|
$columns{''} = 1;
|
|
}
|
|
|
|
my $strcalc ;
|
|
|
|
# Processing average loanperiods
|
|
$strcalc .= "SELECT CONCAT_WS('', borrowers.surname , \",\\t\", borrowers.firstname), COUNT(*) AS `RANK`, borrowers.borrowernumber AS ID";
|
|
$strcalc .= " , $colfield " if ($colfield);
|
|
$strcalc .= " FROM `old_issues`
|
|
LEFT JOIN borrowers USING(borrowernumber)
|
|
LEFT JOIN items USING(itemnumber)
|
|
LEFT JOIN biblioitems USING(biblioitemnumber)
|
|
WHERE old_issues.borrowernumber IS NOT NULL
|
|
";
|
|
my @filterterms = (
|
|
'old_issues.issuedate >',
|
|
'old_issues.issuedate <',
|
|
'old_issues.returndate >',
|
|
'old_issues.returndate <',
|
|
'old_issues.branchcode like',
|
|
'biblioitems.itemtype like',
|
|
'borrowers.categorycode like',
|
|
);
|
|
foreach ((@$filters)[0..9]) {
|
|
my $term = shift @filterterms; # go through both arrays in step
|
|
($_) or next;
|
|
s/\*/%/g;
|
|
$strcalc .= " AND $term '$_' ";
|
|
}
|
|
$strcalc .= " GROUP BY borrowers.borrowernumber";
|
|
$strcalc .= ", $colfield" if ($column);
|
|
$strcalc .= " ORDER BY `RANK` DESC";
|
|
$strcalc .= ",$colfield " if ($colfield);
|
|
$strcalc .= " LIMIT $limit" if ($limit);
|
|
|
|
my $dbcalc = $dbh->prepare($strcalc);
|
|
$dbcalc->execute;
|
|
my %patrons = ();
|
|
# DATA STRUCTURE is going to look like this:
|
|
# (2253=> {name=>"John Doe",
|
|
# allcols=>{MAIN=>12, MEDIA_LIB=>3}
|
|
# },
|
|
# )
|
|
while (my @data = $dbcalc->fetchrow) {
|
|
my ($row, $rank, $id, $col) = @data;
|
|
$col = "zzEMPTY" if (!defined($col));
|
|
unless ($patrons{$id}) {
|
|
$patrons{$id} = {name=>$row, allcols=>{}, newcols=>{}, oldcols=>{}};
|
|
}
|
|
$patrons{$id}->{oldcols}->{$col} = $rank;
|
|
}
|
|
|
|
|
|
$strcalc =~ s/old_issues/issues/g;
|
|
$dbcalc = $dbh->prepare($strcalc);
|
|
$dbcalc->execute;
|
|
while (my @data = $dbcalc->fetchrow) {
|
|
my ($row, $rank, $id, $col) = @data;
|
|
$col = "zzEMPTY" if (!defined($col));
|
|
unless ($patrons{$id}) {
|
|
$patrons{$id} = {name=>$row, allcols=>{}, newcols=>{}, oldcols=>{}};
|
|
}
|
|
$patrons{$id}->{newcols}->{$col} = $rank;
|
|
}
|
|
|
|
foreach my $id (keys %patrons) {
|
|
my @uniq = keys %{{ %{$patrons{$id}->{newcols}}, %{$patrons{$id}->{oldcols}} }}; # get uniq keys, see perlfaq4
|
|
foreach (@uniq) {
|
|
my $count = ($patrons{$id}->{newcols}->{$_} || 0) +
|
|
($patrons{$id}->{oldcols}->{$_} || 0);
|
|
$patrons{$id}->{allcols}->{$_} = $count;
|
|
$patrons{$id}->{total} += $count;
|
|
}
|
|
}
|
|
|
|
my $i = 1;
|
|
my @cols_in_order = sort keys %columns; # if you want to order the columns, do something here
|
|
my @ranked_ids = sort {
|
|
$patrons{$b}->{total} <=> $patrons{$a}->{total}
|
|
|| $patrons{$a}->{name} cmp $patrons{$b}->{name}
|
|
} keys %patrons;
|
|
foreach my $id (@ranked_ids) {
|
|
my @loopcell;
|
|
|
|
foreach my $key (@cols_in_order) {
|
|
if($column){
|
|
push @loopcell, {
|
|
value => $patrons{$id}->{name},
|
|
reference => $id,
|
|
count => $patrons{$id}->{allcols}->{$key},
|
|
};
|
|
}else{
|
|
push @loopcell, {
|
|
value => $patrons{$id}->{name},
|
|
reference => $id,
|
|
count => $patrons{$id}->{total},
|
|
};
|
|
}
|
|
}
|
|
push @looprow,{ 'rowtitle' => $i++ ,
|
|
'loopcell' => \@loopcell,
|
|
'hilighted' => ($i%2),
|
|
};
|
|
# use a limit, if a limit is defined
|
|
last if $i > $limit and $limit
|
|
}
|
|
|
|
# the header of the table
|
|
$globalline{loopfilter}=\@loopfilter;
|
|
# the core of the table
|
|
$globalline{looprow} = \@looprow;
|
|
$globalline{loopcol} = [ map {{coltitle=>$_}} @cols_in_order ];
|
|
# the foot (totals by borrower type)
|
|
$globalline{loopfooter} = [];
|
|
$globalline{total}= $grantotal; # FIXME: useless
|
|
$globalline{column} = $column;
|
|
return [\%globalline]; # reference to a 1 element array: that element is a hashref
|
|
}
|
|
|
|
1;
|
|
__END__
|