Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Bug 12164: Move the budget period clone logic into C4::Budgets

Browse source 
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>
This commit is contained in:
Jonathan Druart 2014-06-02 10:10:53 +02:00 committed by Tomas Cohen Arazi
parent a9c0e18d0a
commit a12e96e938
4 changed files with 150 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

89
C4/Budgets.pm
View file

@ -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;

56
admin/aqbudgetperiods.pl
View file

@ -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';

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

@ -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="[% period_loo.script_name %]?op=delete_confirm&amp;budget_period_id=[% period_loo.budget_period_id %]">Delete</a>
<a href="[% script_name %]?op=add_form&amp;budget_period_id=[% period_loo.budget_period_id |html %]">Edit</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>

50
t/db_dependent/Budgets.t
View file

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