From 53ebcca54ebb3decdd32e1cd3c0a4107746abe7e Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Mon, 2 Jun 2014 10:10:53 +0200 Subject: [PATCH] [PASSED QA] Bug 12164: Move the budget period clone logic into C4::Budgets Note the typo InsertInTable "aqcudgets", note sure about the existing behavior before this patch! This patch adds a link "Duplicate" in the action list for budget periods (budgets). Signed-off-by: Paola Rossi Signed-off-by: Katrin Fischer --- C4/Budgets.pm | 82 ++++++++++++++++++++++ admin/aqbudgetperiods.pl | 56 +++------------ .../prog/en/modules/admin/aqbudgetperiods.tt | 6 +- t/db_dependent/Budgets.t | 50 ++++++++++++- 4 files changed, 143 insertions(+), 51 deletions(-) diff --git a/C4/Budgets.pm b/C4/Budgets.pm index 8dd572e..df9bda6 100644 --- a/C4/Budgets.pm +++ b/C4/Budgets.pm @@ -988,6 +988,88 @@ sub ConvertCurrency { return ( $price / $cur ); } + +=head2 CloneBudgetPeriod + + my $new_budget_period_id = CloneBudgetPeriod({ + budget_period_id => $budget_period_id, + budget_period_startdate => $budget_period_startdate; + $budget_period_enddate => $budget_period_enddate; + }); + +Clone a budget period with all budgets. + +=cut + +sub CloneBudgetPeriod { + my ($params) = @_; + my $budget_period_id = $params->{budget_period_id}; + my $budget_period_startdate = $params->{budget_period_startdate}; + my $budget_period_enddate = $params->{budget_period_enddate}; + + my $budget_period = GetBudgetPeriod($budget_period_id); + + $budget_period->{budget_period_startdate} = $budget_period_startdate; + $budget_period->{budget_period_enddate} = $budget_period_enddate; + my $original_budget_period_id = $budget_period->{budget_period_id}; + delete $budget_period->{budget_period_id}; + my $new_budget_period_id = AddBudgetPeriod( $budget_period ); + + my $budgets = GetBudgetHierarchy($budget_period_id); + CloneBudgetHierarchy( + { budgets => $budgets, new_budget_period_id => $new_budget_period_id } + ); + return $new_budget_period_id; +} + +=head2 CloneBudgetHierarchy + + CloneBudgetHierarchy({ + budgets => $budgets, + new_budget_period_id => $new_budget_period_id; + }); + +Clone a budget hierarchy. + +=cut + +sub CloneBudgetHierarchy { + my ($params) = @_; + my $budgets = $params->{budgets}; + my $new_budget_period_id = $params->{new_budget_period_id}; + next unless @$budgets or $new_budget_period_id; + + my $children_of = $params->{children_of}; + my $new_parent_id = $params->{new_parent_id}; + + my @first_level_budgets = + ( not defined $children_of ) + ? map { ( not $_->{budget_parent_id} ) ? $_ : () } @$budgets + : map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets; + + for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} } + @first_level_budgets ) + { + my $new_budget_id = AddBudget( + { + %$budget, + budget_id => undef, + budget_parent_id => $new_parent_id, + budget_period_id => $new_budget_period_id + } + ); + CloneBudgetHierarchy( + { + budgets => $budgets, + new_budget_period_id => $new_budget_period_id, + children_of => $budget->{budget_id}, + new_parent_id => $new_budget_id + } + ); + } +} + + END { } # module clean-up code here (global destructor) 1; diff --git a/admin/aqbudgetperiods.pl b/admin/aqbudgetperiods.pl index 9371d01..a59e311 100755 --- a/admin/aqbudgetperiods.pl +++ b/admin/aqbudgetperiods.pl @@ -182,57 +182,17 @@ elsif ( $op eq 'duplicate_form'){ # handle the actual duplication elsif ( $op eq 'duplicate_budget' ){ die "please specify a budget period id\n" if( !defined $budget_period_id || $budget_period_id eq '' ); - my $startdate = $input->param('budget_period_startdate'); - my $enddate = $input->param('budget_period_enddate'); - my $data = GetBudgetPeriod( $budget_period_id); - - $data->{'budget_period_startdate'} = $startdate; - $data->{'budget_period_enddate'} = $enddate; - delete $data->{'budget_period_id'}; - my $new_budget_period_id = C4::SQLHelper::InsertInTable('aqbudgetperiods', $data); - - my $tree = GetBudgetHierarchy( $budget_period_id ); - - # hash mapping old ids to new - my %old_new; - # hash mapping old parent ids to list of new children ids - # only store a child here if the parents old id isnt in the old_new map - # when the parent is found, this map will be used, and then the entry removed and their id placed in old_new - my %parent_children; - - for my $entry( @$tree ){ - die "serious errors, parent period $budget_period_id doesnt match child ", $entry->{'budget_period_id'}, "\n" if( $entry->{'budget_period_id'} != $budget_period_id ); - my $orphan = 0; # set to 1 if we need to make an entry in parent_children - my $old_id = delete $entry->{'budget_id'}; - my $parent_id = delete $entry->{'budget_parent_id'}; - $entry->{'budget_period_id'} = $new_budget_period_id; - - if( !defined $parent_id ){ - } elsif( defined $parent_id && $parent_id eq '' ){ - } elsif( defined $old_new{$parent_id} ){ - # set parent id now - $entry->{'budget_parent_id'} = $old_new{$parent_id}; - } else { - # make an entry in parent_children - $parent_children{$parent_id} = [] unless defined $parent_children{$parent_id}; - $orphan = 1; - } + my $budget_period_startdate = $input->param('budget_period_startdate'); + my $budget_period_enddate = $input->param('budget_period_enddate'); - # write it to db - my $new_id = C4::SQLHelper::InsertInTable('aqbudgets', $entry); - $old_new{$old_id} = $new_id; - push @{$parent_children{$parent_id}}, $new_id if $orphan; - - # deal with any children - if( defined $parent_children{$old_id} ){ - # tell my children my new id - for my $child ( @{$parent_children{$old_id}} ){ - C4::SQLHelper::UpdateInTable('aqcudgets', [ 'budget_id' => $child, 'budget_parent_id' => $new_id ]); - } - delete $parent_children{$old_id}; + my $new_budget_period_id = C4::Budgets::CloneBudgetPeriod( + { + budget_period_id => $budget_period_id, + budget_period_startdate => $budget_period_startdate, + budget_period_enddate => $budget_period_enddate, } - } + ); # display the list of budgets $op = 'else'; diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt index 060c450..9bcf311 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt @@ -339,6 +339,7 @@ Edit Delete + Duplicate Add fund @@ -376,8 +377,9 @@ [% IF ( period_loo.budget_period_locked ) %]Locked [% ELSE %][% END %] [% period_loo.budget_period_total %] - Edit - Delete + Edit + Delete + Duplicate Add fund diff --git a/t/db_dependent/Budgets.t b/t/db_dependent/Budgets.t index 7f743ba..3b97dbd 100755 --- a/t/db_dependent/Budgets.t +++ b/t/db_dependent/Budgets.t @@ -1,5 +1,5 @@ use Modern::Perl; -use Test::More tests => 25; +use Test::More tests => 27; BEGIN {use_ok('C4::Budgets') } use C4::Context; @@ -320,3 +320,51 @@ for my $infos (@order_infos) { is( GetBudgetHierarchySpent( $budget_id1 ), 160, "total spent for budget1 is 160" ); is( GetBudgetHierarchySpent( $budget_id11 ), 100, "total spent for budget11 is 100" ); is( GetBudgetHierarchySpent( $budget_id111 ), 20, "total spent for budget111 is 20" ); + +# CloneBudgetPeriod +my $budget_period_id_cloned = C4::Budgets::CloneBudgetPeriod( + { + budget_period_id => $budget_period_id, + budget_period_startdate => '2014-01-01', + budget_period_enddate => '2014-12-31', + } +); + +my $budget_hierarchy = GetBudgetHierarchy($budget_period_id); +my $budget_hierarchy_cloned = GetBudgetHierarchy($budget_period_id_cloned); + +is( + scalar(@$budget_hierarchy_cloned), + scalar(@$budget_hierarchy), + 'CloneBudgetPeriod clones the same number of budgets (funds)' +); +is_deeply( + _get_dependencies($budget_hierarchy), + _get_dependencies($budget_hierarchy_cloned), + 'CloneBudgetPeriod keep the same dependencies order' +); + +sub _get_dependencies { + my ($budget_hierarchy) = @_; + my $graph; + for my $budget (@$budget_hierarchy) { + if ( $budget->{child} ) { + my @sorted = sort @{ $budget->{child} }; + for my $child_id (@sorted) { + push @{ $graph->{ $budget->{budget_name} }{children} }, + _get_budgetname_by_id( $budget_hierarchy, $child_id ); + } + } + push @{ $graph->{ $budget->{budget_name} }{parents} }, + $budget->{parent_id}; + } + return $graph; +} + +sub _get_budgetname_by_id { + my ( $budgets, $budget_id ) = @_; + my ($budget_name) = + map { ( $_->{budget_id} eq $budget_id ) ? $_->{budget_name} : () } + @$budgets; + return $budget_name; +} -- 1.9.1