@@ -, +, @@ * Allow to enter a new name for the duplicate * Add option to transfer the not received orders in the budget copy * Transfer the duplication code in Budgets.pm to allow easier testing. In doing this I removed the code block " # deal with any children" because I just don't understand it and it had a typo in the table name ('aqcudgets'), so I figured it was useless code * Update Budgets.t with the right field names, test the data more and tests the duplication code. Sadly I didn't write tests for the order transfers because it just depends on too much stuff :/ --- C4/Budgets.pm | 61 ++++++++++++++++++++ admin/aqbudgetperiods.pl | 55 ++---------------- .../prog/en/modules/admin/aqbudgetperiods.tt | 10 +++ t/db_dependent/Budgets.t | 38 +++++++++--- 4 files changed, 106 insertions(+), 58 deletions(-) --- a/C4/Budgets.pm +++ a/C4/Budgets.pm @@ -867,6 +867,67 @@ sub CanUserModifyBudget { } # ------------------------------------------------------------------- +sub DuplicateBudget { + my ($budget_period_id, $startdate, $enddate, $budget_period_description, $budget_transfer_data) = @_; + die "please specify a budget period id\n" if( !defined $budget_period_id || $budget_period_id eq '' ); + + my $dbh = C4::Context->dbh; + my $data = GetBudgetPeriod( $budget_period_id); + + $data->{'budget_period_startdate'} = $startdate; + $data->{'budget_period_enddate'} = $enddate; + $data->{'budget_period_description'} = $budget_period_description; + 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; + } + + # 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; + + if ($budget_transfer_data == 1) { + #Transfers the unreceived orders from the previous fund to the new + my $query = " + UPDATE aqorders SET budget_id = ? + WHERE budget_id=? AND + quantityreceived = 0 AND + datecancellationprinted IS NULL"; + my $sth = $dbh->prepare($query); + $sth->execute($new_id, $old_id ); + } + } + + return $new_budget_period_id; +} + +# ------------------------------------------------------------------- =head2 GetCurrencies --- a/admin/aqbudgetperiods.pl +++ a/admin/aqbudgetperiods.pl @@ -173,66 +173,23 @@ elsif ( $op eq 'delete_confirmed' ) { # display the form for duplicating elsif ( $op eq 'duplicate_form'){ + my $budgetperiod = GetBudgetPeriod($budget_period_id, $input); $template->param( 'duplicate_form' => '1', 'budget_period_id' => $budget_period_id, + 'budgetperiod' => $budgetperiod, ); } # 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; - } - - # 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 $budget_period_description = $input->param('budget_period_description'); + my $budget_transfer_data = $input->param('budget_transfer_data'); + C4::Budgets::DuplicateBudget($budget_period_id, $startdate, $enddate, $budget_period_description, $budget_transfer_data); # display the list of budgets $op = 'else'; --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt @@ -198,6 +198,16 @@