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 <paola.rossi@cineca.it>
Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>

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;

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);
+    my $budget_period_startdate = dt_from_string $input->param('budget_period_startdate');
-    $data->{'budget_period_startdate'} = $budget_period_hashref->{budget_period_startdate};
+    my $budget_period_enddate   = dt_from_string $input->param('budget_period_enddate');
-    $data->{'budget_period_enddate'} = $budget_period_hashref->{budget_period_enddate};
-    delete $data->{'budget_period_id'};
-    my $new_budget_period_id = AddBudgetPeriod($data);
 
-    my $tree = GetBudgetHierarchy( $budget_period_id );
+    my $new_budget_period_id = C4::Budgets::CloneBudgetPeriod(
-
+        {
-    # hash mapping old ids to new
+            budget_period_id        => $budget_period_id,
-    my %old_new;
+            budget_period_startdate => $budget_period_startdate,
-    # hash mapping old parent ids to list of new children ids
+            budget_period_enddate   => $budget_period_enddate,
-    # 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;
         }
-
+    );
-        # 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';

koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt

@@ -339,6 +339,7 @@
                 <td>
                   <a href="[% script_name %]?op=add_form&amp;budget_period_id=[% period_active.budget_period_id |html %]">Edit</a>
                   <a href="[% script_name %]?op=delete_confirm&amp;budget_period_id=[% period_active.budget_period_id %]">Delete</a>
+                  <a href="[% script_name %]?op=duplicate_form&amp;budget_period_id=[% period_active.budget_period_id %]">Duplicate</a>
                   <a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&amp;budget_period_id=[% period_active.budget_period_id %]">Add fund</a>
                 </td>
                 </tr>
@@ -376,8 +377,9 @@
                   <td> [% IF ( period_loo.budget_period_locked ) %]<span style="color:green;">Locked</span>&nbsp;[% ELSE %][% END %] </td>
                   <td class="data">[% period_loo.budget_period_total %]</td>
                   <td>
-                      <a href="[% period_loo.script_name %]?op=add_form&amp;budget_period_id=[% period_loo.budget_period_id |html %]">Edit</a>
+                      <a href="[% script_name %]?op=add_form&amp;budget_period_id=[% period_loo.budget_period_id |html %]">Edit</a>
-                      <a href="[% period_loo.script_name %]?op=delete_confirm&amp;budget_period_id=[% period_loo.budget_period_id %]">Delete</a>
+                      <a href="[% script_name %]?op=delete_confirm&amp;budget_period_id=[% period_loo.budget_period_id %]">Delete</a>
+                      <a href="[% script_name %]?op=duplicate_form&amp;budget_period_id=[% period_loo.budget_period_id %]">Duplicate</a>
                   <a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&amp;budget_period_id=[% period_loo.budget_period_id %]">Add fund</a>
                   </td>
                   </tr>

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;
+}