+
+
+
+
Acquisitions statistics
+ [% IF filters.keys.size %]
+
Filtered on:
+
+ [% FOREACH filter IN filters.keys %]
+ -
+ [% INCLUDE field_label name=filter %] :
+ [% value = filters.$filter %]
+ [% display_values.$filter.$value || value %]
+
+ [% END %]
+
+ [% END %]
+
+ [% totalcols = {} %]
+ [% total = 0 %]
+
+
+ [% INCLUDE field_label name=line %] / [% INCLUDE field_label name=column %] |
+ [% FOREACH col IN result.cols %]
+ [% display_values.$column.$col || col %] |
+ [% totalcols.$col = 0 %]
+ [% END %]
+ TOTAL |
+
+ [% FOREACH row IN result.rows %]
+ [% totalrow = 0 %]
+
+ [% display_values.$line.$row || row %] |
+ [% FOREACH col IN result.cols %]
+ [% value = result.table.item(row).item(col) || 0 %]
+ [% value %] |
+
+ [%# Update totals %]
+ [% totalrow = totalrow + value %]
+ [% totalcols.$col = totalcols.$col + value %]
+ [% total = total + value %]
+ [% END %]
+ [% totalrow %] |
+
+ [% END %]
+
+ TOTAL |
+ [% FOREACH col IN result.cols %]
+ [% totalcols.$col %] |
+ [% END %]
+ [% total %] |
+
+
+
+
+
+
+ [% INCLUDE 'reports-menu.inc' %]
+
+
+ [% INCLUDE 'intranet-bottom.inc' %]
--- a/reports/suggestions_stats.pl
+++ a/reports/suggestions_stats.pl
@@ -0,0 +1,268 @@
+#!/usr/bin/perl
+
+# Copyright 2014 BibLibre
+#
+# 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 2 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, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use Modern::Perl;
+use CGI;
+
+use C4::Auth;
+use C4::Context;
+use C4::Output;
+
+use C4::Branch;
+use C4::Budgets;
+use C4::Category;
+use C4::Dates qw/format_date format_date_in_iso/;
+use C4::ItemType;
+use C4::Koha;
+use C4::Reports;
+
+use Koha::I18N;
+
+my $cgi = new CGI;
+my $template_name = 'reports/suggestions_stats.tt';
+my $line = $cgi->param("line");
+my $column = $cgi->param("column");
+
+if ($line and $column) {
+ $template_name = 'reports/suggestions_stats_results.tt';
+}
+
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => $template_name,
+ query => $cgi,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => { reports => '*' },
+ }
+);
+
+if ($line and $column) {
+ my ($filters, $groupby) = ({}, {});
+ foreach my $param ($cgi->param()) {
+ my $value = $cgi->param($param);
+ if ( (defined $value) && ($value ne '') ) {
+ if ($param =~ /^filter_(.*)/) {
+ $filters->{$1} = $cgi->param($param);
+ } elsif ($param =~ /^groupby_(.*)/) {
+ $groupby->{$1} = $cgi->param($param);
+ }
+ }
+ }
+
+ my $result = calculate($line, $column, $groupby, $filters);
+
+ $template->param(
+ line => $line,
+ column => $column,
+ filters => $filters,
+ result => $result,
+ );
+} else {
+ my $budget_hierarchy = C4::Budgets::GetBudgetHierarchy;
+
+ # Remove all children from the first level of this array.
+ @$budget_hierarchy = grep {
+ not defined $_->{budget_parent_id}
+ } @$budget_hierarchy;
+
+ $template->param( budget_hierarchy => $budget_hierarchy);
+}
+
+my $display_values = {};
+
+$display_values->{status} = {
+ ACCEPTED => gettext('Accepted'),
+ ASKED => gettext('Pending'),
+ AVAILABLE => gettext('Available'),
+ CHECKED => gettext('Checked'),
+ ORDERED => gettext('Ordered'),
+ REJECTED => gettext('Rejected'),
+};
+
+my $budgets = C4::Budgets::GetBudgets;
+foreach my $budget (@$budgets) {
+ my $budget_id = $budget->{budget_id};
+ $display_values->{budgetid}->{$budget_id} = $budget->{budget_name};
+}
+
+my @categories = C4::Category->all;
+foreach my $category (@categories) {
+ my $code = $category->categorycode;
+ $display_values->{categorycode}->{$code} = $category->description;
+}
+
+my $bsort1 = C4::Koha::GetAuthorisedValues('Bsort1');
+foreach my $av (@$bsort1) {
+ my $value = $av->{authorised_value};
+ $display_values->{sort1}->{$value} = $av->{lib};
+}
+
+my $bsort2 = C4::Koha::GetAuthorisedValues('Bsort2');
+foreach my $av (@$bsort2) {
+ my $value = $av->{authorised_value};
+ $display_values->{sort2}->{$value} = $av->{lib};
+}
+
+my $suggest = C4::Koha::GetAuthorisedValues('SUGGEST');
+foreach my $av (@$suggest) {
+ my $value = $av->{authorised_value};
+ $display_values->{reason}->{$value} = $av->{lib};
+}
+
+my $branches = C4::Branch::GetBranchesLoop('', 0);
+foreach my $branch (@$branches) {
+ my $branchcode = $branch->{branchcode};
+ $display_values->{branchcode}->{$branchcode} = $branch->{branchname};
+}
+
+my @itemtypes = C4::ItemType->all;
+foreach my $itemtype (@itemtypes) {
+ my $itype = $itemtype->itemtype;
+ $display_values->{itemtype}->{$itype} = $itemtype->description;
+}
+
+$template->param(
+ display_values => $display_values,
+);
+
+output_html_with_http_headers $cgi, $cookie, $template->output;
+
+sub get_select_expr {
+ my ($field, $groupby) = @_;
+
+ my $select_expr = $field;
+ if ($groupby->{$field}) {
+ if ($groupby->{$field} eq 'year') {
+ $select_expr = "DATE_FORMAT($field, '%Y')";
+ } elsif ($groupby->{$field} eq 'month') {
+ $select_expr = "DATE_FORMAT($field, '%Y-%m')";
+ } elsif ($groupby->{$field} eq 'week') {
+ $select_expr = "DATE_FORMAT($field, '%x-%v')";
+ } elsif ($groupby->{$field} eq 'dow') {
+ $select_expr = "DATE_FORMAT($field, '%w - %W')";
+ }
+ }
+
+ return $select_expr;
+}
+
+sub calculate {
+ my ($line, $column, $groupby, $filters) = @_;
+
+ my @valid_fields = (qw(
+ suggesteddate rejecteddate ordereddate publicationyear status budgetid
+ categorycode sort1 sort2 branchcode reason itemtype
+ ));
+ return unless (grep /^$line$/, @valid_fields);
+ return unless (grep /^$column$/, @valid_fields);
+
+ my $dbh = C4::Context->dbh;
+
+ # preparing calculation
+ my $linefield = get_select_expr($line, $groupby);
+ my $colfield = get_select_expr($column, $groupby);
+ my $query = qq|
+ SELECT $linefield AS linefield, $colfield AS columnfield, COUNT(*)
+ FROM suggestions
+ |;
+
+ if (grep /^(categorycode|sort1|sort2)$/, ($line, $column, keys %$filters)) {
+ $query .= ' JOIN borrowers ON (suggestions.suggestedby = borrowers.borrowernumber) ';
+ }
+
+ my @conditions;
+ my @bind_values;
+
+ foreach my $filter (qw(suggesteddate rejecteddate ordereddate)) {
+ if ($filters->{"${filter}_from"}) {
+ push @conditions, "$filter >= ?";
+ push @bind_values, format_date_in_iso($filters->{"${filter}_from"});
+ }
+ if ($filters->{"${filter}_to"}) {
+ push @conditions, "$filter <= ?";
+ push @bind_values, format_date_in_iso($filters->{"${filter}_to"});
+ }
+ }
+
+ foreach my $filter (qw(status categorycode sort1 sort2 branchcode reason itemtype)) {
+ if ($filters->{$filter}) {
+ push @confitions, "$filter = ?";
+ push @bind_values, $filters->{$filter};
+ }
+ }
+
+ if ($filters->{publicationyear_from}) {
+ push @conditions, 'publicationyear >= ?';
+ push @bind_values, $filters->{publicationyear_from};
+ }
+ if ($filters->{publicationyear_to}) {
+ push @conditions, 'publicationyear <= ?';
+ push @bind_values, $filters->{publicationyear_to};
+ }
+
+ if ($filters->{budgetid}) {
+ my @descendants;
+ if ($filters->{budgetid_children}) {
+ @descendants = C4::Budgets::GetBudgetDescendantsIds(
+ $filters->{budgetid});
+ }
+ my $cond = 'budgetid IN ('
+ . join (',', ('?') x (@descendants + 1))
+ . ')';
+ push @conditions, $cond;
+ push @bind_values, $filters->{budgetid}, @descendants;
+ }
+
+ if (@conditions) {
+ $query .= ' WHERE ' . join(' AND ', @conditions);
+ }
+
+ $query .= " GROUP BY linefield, columnfield ORDER BY linefield, columnfield";
+ my $sth = $dbh->prepare($query);
+ $sth->execute(@bind_values);
+
+ my $table;
+ while ( my ( $row, $col, $value ) = $sth->fetchrow ) {
+ $col = "NULL" unless defined $col;
+ $row = "NULL" unless defined $row;
+
+ if (not defined($table->{$row}->{$col})) {
+ $table->{$row}->{$col} = 0;
+ }
+ $table->{$row}->{$col} += $value;
+ }
+
+ my (@rows, @cols);
+ foreach my $row (keys %$table) {
+ foreach my $col (keys %{ $table->{$row} }) {
+ push @cols, $col unless grep /^$col$/, @cols;
+ }
+ push @rows, $row unless grep /^$row$/, @rows;
+ }
+ @rows = sort @rows;
+ @cols = sort @cols;
+
+ my $result = {
+ table => $table,
+ rows => \@rows,
+ cols => \@cols,
+ };
+ return $result;
+}
--- a/t/db_dependent/Budgets.t
+++ a/t/db_dependent/Budgets.t
@@ -1,5 +1,5 @@
use Modern::Perl;
-use Test::More tests => 120;
+use Test::More tests => 124;
BEGIN {
use_ok('C4::Budgets')
@@ -579,6 +579,16 @@ is( C4::Budgets::GetBudget($budget_id2)->{budget_owner_id},
is( C4::Budgets::GetBudget($budget_id21)->{budget_owner_id},
undef, "SetOwnerToFundHierarchy should have set John Doe $john_doe for budget 21 ($budget_id21)" );
+
+my @descendants_ids = C4::Budgets::GetBudgetDescendantsIds($budget_id1);
+is_deeply(\@descendants_ids, [$budget_id11, $budget_id12, $budget_id111]);
+@descendants_ids = C4::Budgets::GetBudgetDescendantsIds($budget_id11);
+is_deeply(\@descendants_ids, [$budget_id111]);
+@descendants_ids = C4::Budgets::GetBudgetDescendantsIds($budget_id111);
+is_deeply(\@descendants_ids, []);
+@descendants_ids = C4::Budgets::GetBudgetDescendantsIds(undef);
+is_deeply(\@descendants_ids, []);
+
sub _get_dependencies {
my ($budget_hierarchy) = @_;
my $graph;
--