From 35c4e42b8c495bb10c61f50bafa360a35394802d Mon Sep 17 00:00:00 2001 From: Julian Maurice Date: Tue, 2 Dec 2014 17:31:03 +0100 Subject: [PATCH] Bug 13392: New statistics assistant for suggestions New sub C4::Budgets::GetBudgetDescendantsIds (with unit tests) Signed-off-by: Nicole Engard Signed-off-by: Josef Moravec --- C4/Budgets.pm | 30 ++ .../prog/en/includes/reports-menu.inc | 1 + .../prog/en/includes/reports/fields.inc | 25 ++ .../prog/en/modules/reports/reports-home.tt | 1 + .../en/modules/reports/suggestions_stats.tt | 186 ++++++++++++ .../reports/suggestions_stats_results.tt | 83 ++++++ reports/suggestions_stats.pl | 268 ++++++++++++++++++ t/db_dependent/Budgets.t | 13 +- 8 files changed, 606 insertions(+), 1 deletion(-) create mode 100644 koha-tmpl/intranet-tmpl/prog/en/includes/reports/fields.inc create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats_results.tt create mode 100755 reports/suggestions_stats.pl diff --git a/C4/Budgets.pm b/C4/Budgets.pm index caacd7cd9c..7d77d04dce 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -193,6 +193,36 @@ sub GetBudgetChildren { |, { Slice => {} }, $budget_id ); } +sub GetBudgetDescendantsIds { + my ($budget_id) = @_; + + return () unless $budget_id; + + my @descendants_ids; + + my $query = q| + SELECT budget_id FROM aqbudgets WHERE budget_parent_id = ? + |; + my $dbh = C4::Context->dbh; + my @children_ids = map { + $_->{budget_id} + } @{ $dbh->selectall_arrayref($query, {Slice => {}}, $budget_id) }; + + while (@children_ids) { + push @descendants_ids, @children_ids; + $query = ' + SELECT budget_id + FROM aqbudgets + WHERE budget_parent_id IN (' . join(',', ('?') x @children_ids) . ')'; + @children_ids = map { + $_->{budget_id} + } @{ $dbh->selectall_arrayref($query, {Slice => {}}, @children_ids) }; + } + + return @descendants_ids; +} + + sub SetOwnerToFundHierarchy { my ( $budget_id, $borrowernumber ) = @_; diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/reports-menu.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/reports-menu.inc index e79f2db105..45f48b285f 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/reports-menu.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/reports-menu.inc @@ -18,6 +18,7 @@
Statistics wizards
  • Acquisitions
  • +
  • Suggestions
  • Patrons
  • Catalog
  • Circulation
  • diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/reports/fields.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/reports/fields.inc new file mode 100644 index 0000000000..5500c146bb --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/reports/fields.inc @@ -0,0 +1,25 @@ +[% BLOCK field_label %] + [% SWITCH name %] + [% CASE 'suggesteddate' %]Suggest date + [% CASE 'suggesteddate_from' %]Suggest date (from) + [% CASE 'suggesteddate_to' %]Suggest date (to) + [% CASE 'rejecteddate' %]Reject date + [% CASE 'rejecteddate_from' %]Reject date (from) + [% CASE 'rejecteddate_to' %]Reject date (to) + [% CASE 'ordereddate' %]Order date + [% CASE 'ordereddate_from' %]Order date (from) + [% CASE 'ordereddate_to' %]Order date (to) + [% CASE 'publicationyear' %]Publication year + [% CASE 'publicationyear_from' %]Publication year (from) + [% CASE 'publicationyear_to' %]Publication year (to) + [% CASE 'status' %]Status + [% CASE 'budgetid' %]Fund + [% CASE 'budgetid_children' %]Include child funds + [% CASE 'categorycode' %]Borrower category + [% CASE 'sort1' %]Borrower sort field 1 + [% CASE 'sort2' %]Borrower sort field 2 + [% CASE 'branchcode' %]Branch + [% CASE 'reason' %]Reject reason + [% CASE 'itemtype' %]Item type + [% END %] +[% END %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/reports/reports-home.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/reports/reports-home.tt index 20be414b9a..6328745651 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/reports/reports-home.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/reports/reports-home.tt @@ -46,6 +46,7 @@

    Statistics wizards

    • Acquisitions
    • +
    • Suggestions
    • Patrons
    • Catalog
    • Circulation
    • diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats.tt new file mode 100644 index 0000000000..e1a2914565 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats.tt @@ -0,0 +1,186 @@ +[% PROCESS 'reports/fields.inc' %] + +[% BLOCK tr %] + + [% INCLUDE field_label name=name %] + + + [% groupby %] + [% filter %] + +[% END %] + +[% BLOCK date_tr %] + [% date_groupby = BLOCK %] + + [% END %] + + [% date_filter = BLOCK %] + From + + [% INCLUDE 'date-format.inc' %] + To + + [% INCLUDE 'date-format.inc' %] + [% END %] + + [% INCLUDE tr groupby=date_groupby filter=date_filter %] +[% END %] + +[% BLOCK select_tr %] + [% select_filter = BLOCK %] + + [% END %] + + [% INCLUDE tr filter=select_filter %] +[% END %] + +[% INCLUDE 'doc-head-open.inc' %] + Koha › Reports › Suggestions statistics + [% INCLUDE 'doc-head-close.inc' %] + [% INCLUDE 'calendar.inc' %] + + + + + [% INCLUDE 'header.inc' %] + [% INCLUDE 'cat-search.inc' %] + + + +
      +
      +
      +
      + +
      +
      + Acquisitions statistics + + + + + + + + + + + + [% INCLUDE date_tr name='suggesteddate' %] + [% INCLUDE date_tr name='rejecteddate' %] + [% INCLUDE date_tr name='ordereddate' %] + + [% publicationyear_filter = BLOCK %] + From + + To + + [% END %] + [% INCLUDE tr name='publicationyear' filter=publicationyear_filter %] + + [% INCLUDE select_tr name='status' %] + [% INCLUDE select_tr name='categorycode' %] + [% INCLUDE select_tr name='sort1' %] + [% INCLUDE select_tr name='sort2' %] + [% INCLUDE select_tr name='branchcode' %] + [% INCLUDE select_tr name='reason' %] + [% INCLUDE select_tr name='itemtype' %] + + [%# Recursive block that display budgets in a hierarchy %] + [% BLOCK budget_option %] + [% indent = indent || 0 %] + + [% FOREACH child IN budget.children %] + [% INCLUDE budget_option budget=child indent=indent+1 %] + [% END %] + [% END %] + + [% budgetid_filter = BLOCK %] + + + + [% END %] + [% INCLUDE tr name='budgetid' filter=budgetid_filter %] + +
      TitleRowColumnGroup byFilter
      +
      + +
      + +
      +
      + +
      +
      + +
      + [% INCLUDE 'reports-menu.inc' %] +
      +
      +
      + + [% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats_results.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats_results.tt new file mode 100644 index 0000000000..c507eb17f3 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/reports/suggestions_stats_results.tt @@ -0,0 +1,83 @@ +[% PROCESS 'reports/fields.inc' %] + +[% INCLUDE 'doc-head-open.inc' %] + Koha › Reports › Acquisitions statistics results + [% INCLUDE 'doc-head-close.inc' %] + [% INCLUDE 'calendar.inc' %] + + + + [% INCLUDE 'header.inc' %] + [% INCLUDE 'cat-search.inc' %] + + + +
      + +
      +
      +
      + +

      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 %] + + + + [% FOREACH col IN result.cols %] + + [% totalcols.$col = 0 %] + [% END %] + + + [% FOREACH row IN result.rows %] + [% totalrow = 0 %] + + + [% FOREACH col IN result.cols %] + [% value = result.table.item(row).item(col) || 0 %] + + + [%# Update totals %] + [% totalrow = totalrow + value %] + [% totalcols.$col = totalcols.$col + value %] + [% total = total + value %] + [% END %] + + + [% END %] + + + [% FOREACH col IN result.cols %] + + [% END %] + + +
      [% INCLUDE field_label name=line %] / [% INCLUDE field_label name=column %][% display_values.$column.$col || col %]TOTAL
      [% display_values.$line.$row || row %][% value %][% totalrow %]
      TOTAL[% totalcols.$col %][% total %]
      +
      +
      + +
      + [% INCLUDE 'reports-menu.inc' %] +
      + + [% INCLUDE 'intranet-bottom.inc' %] diff --git a/reports/suggestions_stats.pl b/reports/suggestions_stats.pl new file mode 100755 index 0000000000..e88aba7cd5 --- /dev/null +++ b/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 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 . + +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 @conditions, "$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; +} diff --git a/t/db_dependent/Budgets.t b/t/db_dependent/Budgets.t index ec14e11369..6fa0a9a6fa 100755 --- a/t/db_dependent/Budgets.t +++ b/t/db_dependent/Budgets.t @@ -1,6 +1,6 @@ #!/usr/bin/perl use Modern::Perl; -use Test::More tests => 146; +use Test::More tests => 150; BEGIN { use_ok('C4::Budgets') @@ -746,6 +746,15 @@ 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_id12, $budget_id11, $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, []); + # Test GetBudgetAuthCats my $budgetPeriodId = AddBudgetPeriod({ @@ -927,6 +936,8 @@ subtest 'GetBudgetSpent and GetBudgetOrdered' => sub { }; +$schema->storage->txn_rollback(); + sub _get_dependencies { my ($budget_hierarchy) = @_; my $graph; -- 2.17.1