Fridolin Somers
381b79593e
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>
463 lines
14 KiB
Perl
Executable file
463 lines
14 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
# Copyright 2008-2009 BibLibre SARL
|
|
# 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>.
|
|
|
|
#script to administer the aqbudgets0 table
|
|
#written 20/02/2002 by paul.poulain@free.fr
|
|
# This software is placed under the gnu General Public License, v2 (http://www.gnu.org/licenses/gpl.html)
|
|
|
|
use Modern::Perl;
|
|
use CGI qw ( -utf8 );
|
|
use Date::Calc qw( Delta_YMD );
|
|
use Date::Manip qw( DateCalc UnixDate );
|
|
use Text::CSV_XS;
|
|
|
|
use C4::Budgets qw(
|
|
CanUserUseBudget
|
|
GetBudgetAuthCats
|
|
GetBudgetHierarchy
|
|
GetBudgetPeriod
|
|
GetBudgetsPlanCell
|
|
GetCols
|
|
GetPeriodsCount
|
|
HideCols
|
|
ModBudgetPlan
|
|
);
|
|
use C4::Context;
|
|
use C4::Output qw( output_html_with_http_headers );
|
|
use C4::Auth qw( get_template_and_user );
|
|
use Koha::Acquisition::Currencies;
|
|
|
|
our $input = CGI->new;
|
|
#### $input
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
|
|
my ( $template, $borrowernumber, $cookie, $staff_flags ) = get_template_and_user(
|
|
{ template_name => "admin/aqplan.tt",
|
|
query => $input,
|
|
type => "intranet",
|
|
flagsrequired => { acquisition => 'planning_manage' },
|
|
}
|
|
);
|
|
|
|
my $budget_period_id = $input->param('budget_period_id');
|
|
# ' ------- get periods stuff ------------------'
|
|
# IF PERIOD_ID IS DEFINED, GET THE PERIOD - ELSE GET THE ACTIVE PERIOD BY DEFAULT
|
|
my $period = GetBudgetPeriod($budget_period_id);
|
|
my $count = GetPeriodsCount();
|
|
my $active_currency = Koha::Acquisition::Currencies->get_active;
|
|
if ( $active_currency ) {
|
|
$template->param( symbol => $active_currency->symbol,
|
|
currency => $active_currency->currency,
|
|
);
|
|
}
|
|
$template->param( period_button_only => 1 ) if $count == 0;
|
|
|
|
|
|
|
|
# authcats_loop populates the YUI planning button
|
|
my $auth_cats_loop = GetBudgetAuthCats($budget_period_id);
|
|
$budget_period_id = $period->{'budget_period_id'};
|
|
my $budget_period_startdate = $period->{'budget_period_startdate'};
|
|
my $budget_period_enddate = $period->{'budget_period_enddate'};
|
|
my $budget_period_locked = $period->{'budget_period_locked'};
|
|
my $budget_period_description = $period->{'budget_period_description'};
|
|
|
|
|
|
$template->param(
|
|
budget_period_id => $budget_period_id,
|
|
budget_period_locked => $budget_period_locked,
|
|
budget_period_description => $budget_period_description,
|
|
auth_cats_loop => $auth_cats_loop,
|
|
);
|
|
|
|
# ------- get periods stuff ------------------
|
|
|
|
|
|
my $borrower_branchcode = my $branch_code = C4::Context->userenv->{'branch'};
|
|
|
|
my $authcat = $input->param('authcat');
|
|
my $show_active = $input->param('show_active') // 0;
|
|
my $show_actual = $input->param('show_actual');
|
|
my $show_percent = $input->param('show_percent');
|
|
my $output = $input->param("output") // q{};
|
|
our $basename = $input->param("basename");
|
|
our $del = C4::Context->csv_delimiter(scalar $input->param("sep"));
|
|
|
|
my $show_mine = $input->param('show_mine') ;
|
|
|
|
my @hide_cols = $input->multi_param('hide_cols');
|
|
|
|
if ( $budget_period_locked == 1 && not defined $show_actual ) {
|
|
$show_actual = 1;
|
|
}
|
|
|
|
$authcat = 'Asort1' if not defined $authcat; # defaults to Asort if no authcat given
|
|
|
|
my $budget_id = $input->param('budget_id');
|
|
my $op = $input->param("op") // q{};
|
|
|
|
my $budgets_ref = GetBudgetHierarchy(
|
|
$budget_period_id,
|
|
$show_mine ? $borrower_branchcode : '',
|
|
$show_mine ? $borrowernumber : ''
|
|
);
|
|
|
|
# build categories list
|
|
my $sth = $dbh->prepare("select distinct category from authorised_values where category like 'A%' ");
|
|
$sth->execute;
|
|
|
|
# the list
|
|
my @category_list;
|
|
|
|
# a hash, to check that some hardcoded categories exist.
|
|
my %categories;
|
|
while ( my ($category) = $sth->fetchrow_array ) {
|
|
push( @category_list, $category );
|
|
$categories{$category} = 1;
|
|
}
|
|
|
|
# push koha system categories
|
|
push( @category_list, 'MONTHS' );
|
|
push( @category_list, 'ITEMTYPES' );
|
|
push( @category_list, 'BRANCHES' );
|
|
push( @category_list, $_ ) foreach @$auth_cats_loop;
|
|
|
|
#reorder the list
|
|
@category_list = sort { $a cmp $b } @category_list;
|
|
|
|
$template->param( authcat_dropbox => {
|
|
values => \@category_list,
|
|
default => $authcat,
|
|
});
|
|
|
|
my @budgets = @$budgets_ref;
|
|
my @authvals;
|
|
my %labels;
|
|
|
|
my @names = $input->multi_param();
|
|
# ------------------------------------------------------------
|
|
if ( $op eq 'save' ) {
|
|
#get budgets
|
|
my ( @buds, @auth_values );
|
|
foreach my $n (@names) {
|
|
next if $n =~ m/^[^0-9]/;
|
|
my @moo = split( ',', $n );
|
|
push @buds, $moo[0];
|
|
push @auth_values, $moo[1];
|
|
}
|
|
|
|
#uniq buds and auth
|
|
my %seen;
|
|
@buds = grep { !$seen{$_}++ } @buds;
|
|
@auth_values = grep { !$seen{$_}++ } @auth_values;
|
|
my @budget_lines;
|
|
|
|
foreach my $budget (@buds) {
|
|
my %budget_line;
|
|
my @cells_line;
|
|
my %cell_hash;
|
|
|
|
foreach my $authvalue (@auth_values) {
|
|
# get actual stats
|
|
my $cell_name = "$budget,$authvalue";
|
|
my $estimated_amount = $input->param("$cell_name");
|
|
my %cell_hash = (
|
|
estimated_amount => $estimated_amount,
|
|
authvalue => $authvalue,
|
|
authcat => $authcat,
|
|
budget_id => $budget,
|
|
budget_period_id => $budget_period_id,
|
|
);
|
|
push( @cells_line, \%cell_hash );
|
|
}
|
|
|
|
%budget_line = (
|
|
lines => \@cells_line,
|
|
);
|
|
push( @budget_lines, \%budget_line );
|
|
}
|
|
my $plan = \@budget_lines;
|
|
ModBudgetPlan( $plan, $budget_period_id, $authcat );
|
|
|
|
HideCols($authcat, @hide_cols);
|
|
|
|
|
|
}
|
|
# ------------------------------------------------------------
|
|
if ( $authcat =~ m/^Asort/ ) {
|
|
my $query = qq{ SELECT * FROM authorised_values WHERE category=? order by lib };
|
|
my $sth = $dbh->prepare($query);
|
|
$sth->execute($authcat );
|
|
if ( $sth->rows > 0 ) {
|
|
for ( my $i = 0 ; $i < $sth->rows ; $i++ ) {
|
|
my $results = $sth->fetchrow_hashref;
|
|
push @authvals, $results->{authorised_value};
|
|
$labels{ $results->{authorised_value} } = $results->{lib};
|
|
}
|
|
}
|
|
$sth->finish;
|
|
@authvals = sort { $a <=> $b } @authvals;
|
|
}
|
|
elsif ( $authcat eq 'MONTHS' && $budget_period_startdate && $budget_period_enddate ) {
|
|
|
|
# build months
|
|
my @start_date = UnixDate( $budget_period_startdate, ( '%Y', '%m', '%d' ) );
|
|
my @end_date = UnixDate( $budget_period_enddate, ( '%Y', '%m', '%d' ) );
|
|
|
|
my ( $Dy, $Dm, $Dd ) = Delta_YMD( @start_date, @end_date );
|
|
|
|
#calc number of months between
|
|
my $months = ( $Dy * 12 ) + $Dm;
|
|
my $start_month = $start_date[1];
|
|
my $end_month = ( $Dy * 12 ) + $Dm;
|
|
|
|
for my $mth ( 0 ... $months ) {
|
|
$mth = DateCalc( $budget_period_startdate, "+ $mth months" );
|
|
$mth = UnixDate( $mth, "%Y-%m" );
|
|
push( @authvals, $mth );
|
|
}
|
|
foreach my $vv (@authvals) {
|
|
$labels{$vv} = $vv;
|
|
}
|
|
}
|
|
|
|
elsif ( $authcat eq 'ITEMTYPES' ) {
|
|
my $query = qq| SELECT itemtype, description FROM itemtypes |;
|
|
my $sth = $dbh->prepare($query);
|
|
$sth->execute( );
|
|
|
|
if ( $sth->rows > 0 ) {
|
|
for ( my $i = 0 ; $i < $sth->rows ; $i++ ) {
|
|
my $results = $sth->fetchrow_hashref;
|
|
push @authvals, $results->{itemtype};
|
|
$labels{ $results->{itemtype} } = $results->{description};
|
|
}
|
|
}
|
|
$sth->finish;
|
|
|
|
} elsif ( $authcat eq 'BRANCHES' ) {
|
|
|
|
my $query = qq| SELECT branchcode, branchname FROM branches |;
|
|
my $sth = $dbh->prepare($query);
|
|
$sth->execute();
|
|
|
|
if ( $sth->rows > 0 ) {
|
|
for ( my $i = 0 ; $i < $sth->rows ; $i++ ) {
|
|
my $results = $sth->fetchrow_hashref;
|
|
push @authvals, $results->{branchcode};
|
|
$labels{ $results->{branchcode} } = $results->{branchname};
|
|
}
|
|
}
|
|
$sth->finish;
|
|
} elsif ($authcat) {
|
|
my $query = qq{ SELECT * FROM authorised_values WHERE category=? order by lib };
|
|
my $sth = $dbh->prepare($query);
|
|
$sth->execute($authcat);
|
|
if ( $sth->rows > 0 ) {
|
|
for ( my $i = 0 ; $i < $sth->rows ; $i++ ) {
|
|
my $results = $sth->fetchrow_hashref;
|
|
push @authvals, $results->{authorised_value};
|
|
$labels{ $results->{authorised_value} } = $results->{lib};
|
|
}
|
|
}
|
|
$sth->finish;
|
|
}
|
|
|
|
my @authvals_row;
|
|
my $i=1;
|
|
foreach my $val (@authvals) {
|
|
my %auth_hash;
|
|
$auth_hash{val} = $labels{$val};
|
|
$auth_hash{code} = $val;
|
|
$auth_hash{colnum} = $i++;
|
|
|
|
# display lookup
|
|
$auth_hash{display} = GetCols( $authcat, $auth_hash{code});
|
|
|
|
push( @authvals_row, \%auth_hash );
|
|
}
|
|
|
|
#get budgets
|
|
my ( @buds, @auth_values );
|
|
foreach my $n (@names) {
|
|
next if $n =~ m/^[^0-9]/;
|
|
$n =~ m/(\d*),(.*)/;
|
|
push @buds, $1;
|
|
push @auth_values, $2;
|
|
}
|
|
|
|
|
|
# ------------------------------------------------------------
|
|
# DEFAULT DISPLAY BEGINS
|
|
|
|
my $CGIextChoice = ( 'CSV' ); # FIXME translation
|
|
my $CGIsepChoice = ( C4::Context->csv_delimiter );
|
|
|
|
my ( @budget_lines, %cell_hash );
|
|
|
|
|
|
foreach my $budget (@budgets) {
|
|
my $budget_lock;
|
|
|
|
unless (CanUserUseBudget($borrowernumber, $budget, $staff_flags)) {
|
|
$budget_lock = 1
|
|
}
|
|
|
|
# check budget permission
|
|
if ( $period->{budget_period_locked} == 1 ) {
|
|
$budget_lock = 1;
|
|
} elsif ( $budget->{budget_permission} == 1 ) {
|
|
$budget_lock = 1 if $borrowernumber != $budget->{'budget_owner_id'};
|
|
} elsif ( $budget->{budget_permission} == 2 ) {
|
|
$budget_lock = 1 if $borrower_branchcode ne $budget->{budget_branchcode};
|
|
}
|
|
|
|
# allow hard-coded itemtype and branch planning
|
|
unless ( $authcat eq 'ITEMTYPES'
|
|
or $authcat eq 'BRANCHES'
|
|
or $authcat eq 'MONTHS' ) {
|
|
|
|
# but skip budgets that don't match the current auth-category
|
|
next if ( $budget->{'sort1_authcat'} ne $authcat
|
|
&& $budget->{'sort2_authcat'} ne $authcat );
|
|
}
|
|
|
|
my %budget_line; # each row of the table
|
|
my @cells_line;
|
|
my $actual_spent;
|
|
my $estimated_spent;
|
|
|
|
my $i = 0;
|
|
foreach my $authvalue (@authvals) {
|
|
|
|
# get actual stats
|
|
my %cell = (
|
|
budget_id => $budget->{'budget_id'},
|
|
budget_period_id => $budget->{'budget_period_id'},
|
|
cell_name => $budget->{'budget_id'} . ',' . $authvalue,
|
|
authvalue => $authvalue,
|
|
authcat => $authcat,
|
|
cell_authvalue => $authvalue,
|
|
budget_lock => $budget_lock,
|
|
);
|
|
|
|
my ( $actual, $estimated, $display ) = GetBudgetsPlanCell( \%cell, $period, $budget );
|
|
$cell{actual_amount} = sprintf( "%.2f", $actual // 0 );
|
|
$cell{estimated_amount} = sprintf( "%.2f", $estimated // 0 );
|
|
$cell{display} = $authvals_row[$i]{display};
|
|
$cell{colnum} = $i;
|
|
|
|
$actual_spent += $cell{actual_amount};
|
|
$estimated_spent += $cell{estimated_amount};
|
|
|
|
|
|
push( @cells_line, \%cell );
|
|
$i++;
|
|
}
|
|
|
|
my $budget_act_remain = $budget->{budget_amount} - $actual_spent;
|
|
my $budget_est_remain = $budget->{budget_amount} - $estimated_spent;
|
|
|
|
%budget_line = (
|
|
lines => \@cells_line,
|
|
budget_name => $budget->{budget_name},
|
|
budget_amount => $budget->{budget_amount},
|
|
budget_alloc => $budget->{budget_alloc},
|
|
budget_act_remain => sprintf( "%.2f", $budget_act_remain ),
|
|
budget_est_remain => sprintf( "%.2f", $budget_est_remain ),
|
|
budget_id => $budget->{budget_id},
|
|
budget_lock => $budget_lock,
|
|
);
|
|
|
|
|
|
|
|
$budget_line{est_negative} = '1' if $budget_est_remain < 0;
|
|
$budget_line{est_positive} = '1' if $budget_est_remain > 0;
|
|
$budget_line{act_negative} = '1' if $budget_act_remain < 0;
|
|
$budget_line{act_positive} = '1' if $budget_act_remain > 0;
|
|
|
|
# skip if active set , and spent == 0
|
|
next if ( $show_active == '1' && ( $actual_spent == 0 ) );
|
|
|
|
push( @budget_lines, \%budget_line );
|
|
}
|
|
|
|
if ( $output eq "file" ) {
|
|
_print_to_csv(\@authvals_row, \@budget_lines);
|
|
exit(1);
|
|
}
|
|
|
|
$template->param(
|
|
authvals_row => \@authvals_row,
|
|
budget_lines => \@budget_lines,
|
|
budget_period_description => $period->{'budget_period_description'},
|
|
budget_period_locked => $period->{'budget_period_locked'},
|
|
budget_period_id => $budget_period_id,
|
|
authcat => $authcat,
|
|
show_active => $show_active,
|
|
show_actual => $show_actual,
|
|
show_percent => $show_percent,
|
|
show_mine => $show_mine,
|
|
CGIextChoice => $CGIextChoice,
|
|
CGIsepChoice => $CGIsepChoice,
|
|
|
|
authvals => \@authvals_row,
|
|
hide_cols_loop => \@hide_cols,
|
|
);
|
|
|
|
output_html_with_http_headers $input, $cookie, $template->output;
|
|
|
|
sub _print_to_csv {
|
|
my ( $header, $results ) = @_;
|
|
|
|
binmode STDOUT, ':encoding(UTF-8)';
|
|
|
|
my $csv = Text::CSV_XS->new(
|
|
{ sep_char => $del,
|
|
always_quote => 'TRUE',
|
|
}
|
|
);
|
|
print $input->header(
|
|
-type => 'application/vnd.sun.xml.calc',
|
|
-encoding => 'utf-8',
|
|
-attachment => "$basename.csv",
|
|
-name => "$basename.csv"
|
|
);
|
|
my @col = ( 'Budget name', 'Budget total' );
|
|
foreach my $row (@$header) {
|
|
push @col, $row->{'val'};
|
|
}
|
|
push @col, 'Budget remaining';
|
|
|
|
$csv->combine(@col);
|
|
my $str = $csv->string;
|
|
print "$str\n";
|
|
|
|
foreach my $row (@$results) {
|
|
my @col = ( $row->{'budget_name'}, $row->{'budget_amount'} );
|
|
my $l = $row->{'lines'};
|
|
foreach my $line (@$l) {
|
|
push @col, $line->{'estimated_amount'};
|
|
}
|
|
push @col, $row->{'budget_est_remain'};
|
|
$csv->combine(@col);
|
|
my $str = $csv->string;
|
|
print "$str\n";
|
|
}
|
|
}
|