Attachment #28702 for bug #12164

View | Details | Raw Unified | Return to bug 12164
Collapse All | Expand All




    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;




# 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 $budget_period_startdate = $input->param('budget_period_startdate');
    my $budget_period_enddate   = $input->param('budget_period_enddate');
    $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 $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,
        # 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};
        }
    );

    # display the list of budgets
    $op = 'else';




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

                  <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="[% 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>




use Modern::Perl;
use Test::More tests => 27;

BEGIN {use_ok('C4::Budgets') }
use C4::Context;

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

Return to bug 12164

Lines 988-993 sub ConvertCurrency { Link Here

(-)a/C4/Budgets.pm (+82 lines)
988	return ( $price / $cur );	988	return ( $price / $cur );
989	}	989	}
990		990
		991
		992	=head2 CloneBudgetPeriod
		993
		994	my $new_budget_period_id = CloneBudgetPeriod({
		995	budget_period_id => $budget_period_id,
		996	budget_period_startdate => $budget_period_startdate;
		997	$budget_period_enddate => $budget_period_enddate;
		998	});
		999
		1000	Clone a budget period with all budgets.
		1001
		1002	=cut
		1003
		1004	sub CloneBudgetPeriod {
		1005	my ($params) = @_;
		1006	my $budget_period_id = $params->{budget_period_id};
		1007	my $budget_period_startdate = $params->{budget_period_startdate};
		1008	my $budget_period_enddate = $params->{budget_period_enddate};
		1009
		1010	my $budget_period = GetBudgetPeriod($budget_period_id);
		1011
		1012	$budget_period->{budget_period_startdate} = $budget_period_startdate;
		1013	$budget_period->{budget_period_enddate} = $budget_period_enddate;
		1014	my $original_budget_period_id = $budget_period->{budget_period_id};
		1015	delete $budget_period->{budget_period_id};
		1016	my $new_budget_period_id = AddBudgetPeriod( $budget_period );
		1017
		1018	my $budgets = GetBudgetHierarchy($budget_period_id);
		1019	CloneBudgetHierarchy(
		1020	{ budgets => $budgets, new_budget_period_id => $new_budget_period_id }
		1021	);
		1022	return $new_budget_period_id;
		1023	}
		1024
		1025	=head2 CloneBudgetHierarchy
		1026
		1027	CloneBudgetHierarchy({
		1028	budgets => $budgets,
		1029	new_budget_period_id => $new_budget_period_id;
		1030	});
		1031
		1032	Clone a budget hierarchy.
		1033
		1034	=cut
		1035
		1036	sub CloneBudgetHierarchy {
		1037	my ($params) = @_;
		1038	my $budgets = $params->{budgets};
		1039	my $new_budget_period_id = $params->{new_budget_period_id};
		1040	next unless @$budgets or $new_budget_period_id;
		1041
		1042	my $children_of = $params->{children_of};
		1043	my $new_parent_id = $params->{new_parent_id};
		1044
		1045	my @first_level_budgets =
		1046	( not defined $children_of )
		1047	? map { ( not $_->{budget_parent_id} ) ? $_ : () } @$budgets
		1048	: map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;
		1049
		1050	for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
		1051	@first_level_budgets )
		1052	{
		1053	my $new_budget_id = AddBudget(
		1054	{
1055	%$budget,
1056	budget_id => undef,
1057	budget_parent_id => $new_parent_id,
1058	budget_period_id => $new_budget_period_id
1059	}
1060	);
1061	CloneBudgetHierarchy(
1062	{
1063	budgets => $budgets,
1064	new_budget_period_id => $new_budget_period_id,
1065	children_of => $budget->{budget_id},
1066	new_parent_id => $new_budget_id
1067	}
1068	);
1069	}
1070	}
1071
1072
991	END { } # module clean-up code here (global destructor)	1073	END { } # module clean-up code here (global destructor)
992		1074
993	1;	1075	1;

Lines 182-238 elsif ( $op eq 'duplicate_form'){ Link Here

(-)a/admin/aqbudgetperiods.pl (-48 / +8 lines)
182	# handle the actual duplication	182	# handle the actual duplication
183	elsif ( $op eq 'duplicate_budget' ){	183	elsif ( $op eq 'duplicate_budget' ){
184	die "please specify a budget period id\n" if( !defined $budget_period_id \|\| $budget_period_id eq '' );	184	die "please specify a budget period id\n" if( !defined $budget_period_id \|\| $budget_period_id eq '' );
185	my $startdate = $input->param('budget_period_startdate');
186	my $enddate = $input->param('budget_period_enddate');
187		185
188	my $data = GetBudgetPeriod( $budget_period_id);	186	my $budget_period_startdate = $input->param('budget_period_startdate');
189		187	my $budget_period_enddate = $input->param('budget_period_enddate');
190	$data->{'budget_period_startdate'} = $startdate;
191	$data->{'budget_period_enddate'} = $enddate;
192	delete $data->{'budget_period_id'};
193	my $new_budget_period_id = C4::SQLHelper::InsertInTable('aqbudgetperiods', $data);
194
195	my $tree = GetBudgetHierarchy( $budget_period_id );
196
197	# hash mapping old ids to new
198	my %old_new;
199	# hash mapping old parent ids to list of new children ids
200	# only store a child here if the parents old id isnt in the old_new map
201	# when the parent is found, this map will be used, and then the entry removed and their id placed in old_new
202	my %parent_children;
203
204	for my $entry( @$tree ){
205	die "serious errors, parent period $budget_period_id doesnt match child ", $entry->{'budget_period_id'}, "\n" if( $entry->{'budget_period_id'} != $budget_period_id );
206	my $orphan = 0; # set to 1 if we need to make an entry in parent_children
207	my $old_id = delete $entry->{'budget_id'};
208	my $parent_id = delete $entry->{'budget_parent_id'};
209	$entry->{'budget_period_id'} = $new_budget_period_id;
210
211	if( !defined $parent_id ){
212	} elsif( defined $parent_id && $parent_id eq '' ){
213	} elsif( defined $old_new{$parent_id} ){
214	# set parent id now
215	$entry->{'budget_parent_id'} = $old_new{$parent_id};
216	} else {
217	# make an entry in parent_children
218	$parent_children{$parent_id} = [] unless defined $parent_children{$parent_id};
219	$orphan = 1;
220	}
221		188
222	# write it to db	189	my $new_budget_period_id = C4::Budgets::CloneBudgetPeriod(
223	my $new_id = C4::SQLHelper::InsertInTable('aqbudgets', $entry);	190	{
224	$old_new{$old_id} = $new_id;	191	budget_period_id => $budget_period_id,
225	push @{$parent_children{$parent_id}}, $new_id if $orphan;	192	budget_period_startdate => $budget_period_startdate,
226		193	budget_period_enddate => $budget_period_enddate,
227	# deal with any children
228	if( defined $parent_children{$old_id} ){
229	# tell my children my new id
230	for my $child ( @{$parent_children{$old_id}} ){
231	C4::SQLHelper::UpdateInTable('aqcudgets', [ 'budget_id' => $child, 'budget_parent_id' => $new_id ]);
232	}
233	delete $parent_children{$old_id};
234	}	194	}
235	}	195	);
236		196
237	# display the list of budgets	197	# display the list of budgets
238	$op = 'else';	198	$op = 'else';

Lines 339-344 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt (-2 / +4 lines)
339	<td>	339	<td>
340	<a href="[% script_name %]?op=add_form&budget_period_id=[% period_active.budget_period_id \|html %]">Edit</a>	340	<a href="[% script_name %]?op=add_form&budget_period_id=[% period_active.budget_period_id \|html %]">Edit</a>
341	<a href="[% script_name %]?op=delete_confirm&budget_period_id=[% period_active.budget_period_id %]">Delete</a>	341	<a href="[% script_name %]?op=delete_confirm&budget_period_id=[% period_active.budget_period_id %]">Delete</a>
		342	<a href="[% script_name %]?op=duplicate_form&budget_period_id=[% period_active.budget_period_id %]">Duplicate</a>
342	<a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&budget_period_id=[% period_active.budget_period_id %]">Add fund</a>	343	<a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&budget_period_id=[% period_active.budget_period_id %]">Add fund</a>
343	</td>	344	</td>
344	</tr>	345	</tr>
Lines 376-383 Link Here
376	<td> [% IF ( period_loo.budget_period_locked ) %]<span style="color:green;">Locked</span> [% ELSE %][% END %] </td>	377	<td> [% IF ( period_loo.budget_period_locked ) %]<span style="color:green;">Locked</span> [% ELSE %][% END %] </td>
377	<td class="data">[% period_loo.budget_period_total %]</td>	378	<td class="data">[% period_loo.budget_period_total %]</td>
378	<td>	379	<td>
379	<a href="[% period_loo.script_name %]?op=add_form&budget_period_id=[% period_loo.budget_period_id \|html %]">Edit</a>	380	<a href="[% script_name %]?op=add_form&budget_period_id=[% period_loo.budget_period_id \|html %]">Edit</a>
380	<a href="[% period_loo.script_name %]?op=delete_confirm&budget_period_id=[% period_loo.budget_period_id %]">Delete</a>	381	<a href="[% script_name %]?op=delete_confirm&budget_period_id=[% period_loo.budget_period_id %]">Delete</a>
		382	<a href="[% script_name %]?op=duplicate_form&budget_period_id=[% period_loo.budget_period_id %]">Duplicate</a>
381	<a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&budget_period_id=[% period_loo.budget_period_id %]">Add fund</a>	383	<a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&budget_period_id=[% period_loo.budget_period_id %]">Add fund</a>
382	</td>	384	</td>
383	</tr>	385	</tr>

Lines 1-5 Link Here

(-)a/t/db_dependent/Budgets.t (-2 / +49 lines)
1	use Modern::Perl;	1	use Modern::Perl;
2	use Test::More tests => 25;	2	use Test::More tests => 27;
3		3
4	BEGIN {use_ok('C4::Budgets') }	4	BEGIN {use_ok('C4::Budgets') }
5	use C4::Context;	5	use C4::Context;
Lines 320-322 for my $infos (@order_infos) { Link Here
320	is( GetBudgetHierarchySpent( $budget_id1 ), 160, "total spent for budget1 is 160" );	320	is( GetBudgetHierarchySpent( $budget_id1 ), 160, "total spent for budget1 is 160" );
321	is( GetBudgetHierarchySpent( $budget_id11 ), 100, "total spent for budget11 is 100" );	321	is( GetBudgetHierarchySpent( $budget_id11 ), 100, "total spent for budget11 is 100" );
322	is( GetBudgetHierarchySpent( $budget_id111 ), 20, "total spent for budget111 is 20" );	322	is( GetBudgetHierarchySpent( $budget_id111 ), 20, "total spent for budget111 is 20" );
323	-	323
		324	# CloneBudgetPeriod
		325	my $budget_period_id_cloned = C4::Budgets::CloneBudgetPeriod(
		326	{
		327	budget_period_id => $budget_period_id,
		328	budget_period_startdate => '2014-01-01',
		329	budget_period_enddate => '2014-12-31',
		330	}
		331	);
		332
		333	my $budget_hierarchy = GetBudgetHierarchy($budget_period_id);
		334	my $budget_hierarchy_cloned = GetBudgetHierarchy($budget_period_id_cloned);
		335
		336	is(
		337	scalar(@$budget_hierarchy_cloned),
		338	scalar(@$budget_hierarchy),
		339	'CloneBudgetPeriod clones the same number of budgets (funds)'
		340	);
		341	is_deeply(
		342	_get_dependencies($budget_hierarchy),
		343	_get_dependencies($budget_hierarchy_cloned),
		344	'CloneBudgetPeriod keep the same dependencies order'
		345	);
		346
		347	sub _get_dependencies {
		348	my ($budget_hierarchy) = @_;
		349	my $graph;
		350	for my $budget (@$budget_hierarchy) {
		351	if ( $budget->{child} ) {
		352	my @sorted = sort @{ $budget->{child} };
		353	for my $child_id (@sorted) {
		354	push @{ $graph->{ $budget->{budget_name} }{children} },
		355	_get_budgetname_by_id( $budget_hierarchy, $child_id );
		356	}
		357	}
		358	push @{ $graph->{ $budget->{budget_name} }{parents} },
		359	$budget->{parent_id};
		360	}
		361	return $graph;
		362	}
		363
		364	sub _get_budgetname_by_id {
		365	my ( $budgets, $budget_id ) = @_;
		366	my ($budget_name) =
		367	map { ( $_->{budget_id} eq $budget_id ) ? $_->{budget_name} : () }
		368	@$budgets;
		369	return $budget_name;
		370	}