diff --git a/C4/Budgets.pm b/C4/Budgets.pm
index 30b9079810..1f7ad3aa4c 100644
--- a/C4/Budgets.pm
+++ b/C4/Budgets.pm
@@ -1008,6 +1008,95 @@ 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;
+
+ # get only the columns of aqbudgets
+ my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
+
+ for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
+ @first_level_budgets )
+ {
+
+ my $tidy_budget =
+ { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
+ keys($budget) };
+ my $new_budget_id = AddBudget(
+ {
+ %$tidy_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 3319d05a2f..8c0409df1d 100755
--- a/admin/aqbudgetperiods.pl
+++ b/admin/aqbudgetperiods.pl
@@ -187,56 +187,16 @@ elsif ( $op eq 'duplicate_form'){
elsif ( $op eq 'duplicate_budget' ){
die "please specify a budget period id\n" if( !defined $budget_period_id || $budget_period_id eq '' );
- my $data = GetBudgetPeriod( $budget_period_id);
- $data->{'budget_period_startdate'} = $budget_period_hashref->{budget_period_startdate};
- $data->{'budget_period_enddate'} = $budget_period_hashref->{budget_period_enddate};
- delete $data->{'budget_period_id'};
- my $new_budget_period_id = AddBudgetPeriod($data);
+ my $budget_period_startdate = dt_from_string $input->param('budget_period_startdate');
+ my $budget_period_enddate = dt_from_string $input->param('budget_period_enddate');
- 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 $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,
}
-
- # get only the columns of aqbudgets
- my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
- my $new_entry = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $entry->{$_} ) : () } keys(%$entry) };
- # write it to db
- my $new_id = AddBudget($new_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}} ){
- ModBudget( { 'budget_id' => $child, 'budget_parent_id' => $new_id } );
- }
- delete $parent_children{$old_id};
- }
- }
+ );
# 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 060c45050a..9bcf3115cb 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 39e0de61e3..94a82150ff 100755
--- a/t/db_dependent/Budgets.t
+++ b/t/db_dependent/Budgets.t
@@ -1,5 +1,5 @@
use Modern::Perl;
-use Test::More tests => 63;
+use Test::More tests => 65;
BEGIN {
use_ok('C4::Budgets')
@@ -352,3 +352,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;
+}