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

(-)a/C4/Budgets.pm (+89 lines)
Lines 1008-1013 sub ConvertCurrency { Link Here
1008
    return ( $price / $cur );
1008
    return ( $price / $cur );
1009
}
1009
}
1010
1010
1011
1012
=head2 CloneBudgetPeriod
1013
1014
  my $new_budget_period_id = CloneBudgetPeriod({
1015
    budget_period_id => $budget_period_id,
1016
    budget_period_startdate => $budget_period_startdate;
1017
    $budget_period_enddate   => $budget_period_enddate;
1018
  });
1019
1020
Clone a budget period with all budgets.
1021
1022
=cut
1023
1024
sub CloneBudgetPeriod {
1025
    my ($params)                = @_;
1026
    my $budget_period_id        = $params->{budget_period_id};
1027
    my $budget_period_startdate = $params->{budget_period_startdate};
1028
    my $budget_period_enddate   = $params->{budget_period_enddate};
1029
1030
    my $budget_period = GetBudgetPeriod($budget_period_id);
1031
1032
    $budget_period->{budget_period_startdate} = $budget_period_startdate;
1033
    $budget_period->{budget_period_enddate}   = $budget_period_enddate;
1034
    my $original_budget_period_id = $budget_period->{budget_period_id};
1035
    delete $budget_period->{budget_period_id};
1036
    my $new_budget_period_id = AddBudgetPeriod( $budget_period );
1037
1038
    my $budgets = GetBudgetHierarchy($budget_period_id);
1039
    CloneBudgetHierarchy(
1040
        { budgets => $budgets, new_budget_period_id => $new_budget_period_id }
1041
    );
1042
    return $new_budget_period_id;
1043
}
1044
1045
=head2 CloneBudgetHierarchy
1046
1047
  CloneBudgetHierarchy({
1048
    budgets => $budgets,
1049
    new_budget_period_id => $new_budget_period_id;
1050
  });
1051
1052
Clone a budget hierarchy.
1053
1054
=cut
1055
1056
sub CloneBudgetHierarchy {
1057
    my ($params)             = @_;
1058
    my $budgets              = $params->{budgets};
1059
    my $new_budget_period_id = $params->{new_budget_period_id};
1060
    next unless @$budgets or $new_budget_period_id;
1061
1062
    my $children_of   = $params->{children_of};
1063
    my $new_parent_id = $params->{new_parent_id};
1064
1065
    my @first_level_budgets =
1066
      ( not defined $children_of )
1067
      ? map { ( not $_->{budget_parent_id} )             ? $_ : () } @$budgets
1068
      : map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;
1069
1070
    # get only the columns of aqbudgets
1071
    my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
1072
1073
    for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
1074
        @first_level_budgets )
1075
    {
1076
1077
        my $tidy_budget =
1078
          { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
1079
              keys($budget) };
1080
        my $new_budget_id = AddBudget(
1081
            {
1082
                %$tidy_budget,
1083
                budget_id        => undef,
1084
                budget_parent_id => $new_parent_id,
1085
                budget_period_id => $new_budget_period_id
1086
            }
1087
        );
1088
        CloneBudgetHierarchy(
1089
            {
1090
                budgets              => $budgets,
1091
                new_budget_period_id => $new_budget_period_id,
1092
                children_of          => $budget->{budget_id},
1093
                new_parent_id        => $new_budget_id
1094
            }
1095
        );
1096
    }
1097
}
1098
1099
1011
END { }    # module clean-up code here (global destructor)
1100
END { }    # module clean-up code here (global destructor)
1012
1101
1013
1;
1102
1;
(-)a/admin/aqbudgetperiods.pl (-49 / +9 lines)
Lines 186-241 elsif ( $op eq 'duplicate_form'){ Link Here
186
elsif ( $op eq 'duplicate_budget' ){
186
elsif ( $op eq 'duplicate_budget' ){
187
    die "please specify a budget period id\n" if( !defined $budget_period_id || $budget_period_id eq '' );
187
    die "please specify a budget period id\n" if( !defined $budget_period_id || $budget_period_id eq '' );
188
188
189
    my $data = GetBudgetPeriod( $budget_period_id);
189
    my $budget_period_startdate = dt_from_string $input->param('budget_period_startdate');
190
    $data->{'budget_period_startdate'} = $budget_period_hashref->{budget_period_startdate};
190
    my $budget_period_enddate   = dt_from_string $input->param('budget_period_enddate');
191
    $data->{'budget_period_enddate'} = $budget_period_hashref->{budget_period_enddate};
191
192
    delete $data->{'budget_period_id'};
192
    my $new_budget_period_id = C4::Budgets::CloneBudgetPeriod(
193
    my $new_budget_period_id = AddBudgetPeriod($data);
193
        {
194
194
            budget_period_id        => $budget_period_id,
195
    my $tree = GetBudgetHierarchy( $budget_period_id );
195
            budget_period_startdate => $budget_period_startdate,
196
196
            budget_period_enddate   => $budget_period_enddate,
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
222
        # get only the columns of aqbudgets
223
        my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
224
        my $new_entry = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $entry->{$_} )  : () } keys(%$entry) };
225
        # write it to db
226
        my $new_id = AddBudget($new_entry);
227
        $old_new{$old_id} = $new_id;
228
        push @{$parent_children{$parent_id}}, $new_id if $orphan;
229
230
        # deal with any children
231
        if( defined $parent_children{$old_id} ){
232
            # tell my children my new id
233
            for my $child ( @{$parent_children{$old_id}} ){
234
                ModBudget( { 'budget_id' => $child, 'budget_parent_id' => $new_id } );
235
            }
236
            delete $parent_children{$old_id};
237
        }
197
        }
238
    }
198
    );
239
199
240
    # display the list of budgets
200
    # display the list of budgets
241
    $op = 'else';
201
    $op = 'else';
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/aqbudgetperiods.tt (-2 / +4 lines)
Lines 339-344 Link Here
339
                <td>
339
                <td>
340
                  <a href="[% script_name %]?op=add_form&amp;budget_period_id=[% period_active.budget_period_id |html %]">Edit</a>
340
                  <a href="[% script_name %]?op=add_form&amp;budget_period_id=[% period_active.budget_period_id |html %]">Edit</a>
341
                  <a href="[% script_name %]?op=delete_confirm&amp;budget_period_id=[% period_active.budget_period_id %]">Delete</a>
341
                  <a href="[% script_name %]?op=delete_confirm&amp;budget_period_id=[% period_active.budget_period_id %]">Delete</a>
342
                  <a href="[% script_name %]?op=duplicate_form&amp;budget_period_id=[% period_active.budget_period_id %]">Duplicate</a>
342
                  <a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&amp;budget_period_id=[% period_active.budget_period_id %]">Add fund</a>
343
                  <a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&amp;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>&nbsp;[% ELSE %][% END %] </td>
377
                  <td> [% IF ( period_loo.budget_period_locked ) %]<span style="color:green;">Locked</span>&nbsp;[% 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&amp;budget_period_id=[% period_loo.budget_period_id |html %]">Edit</a>
380
                      <a href="[% script_name %]?op=add_form&amp;budget_period_id=[% period_loo.budget_period_id |html %]">Edit</a>
380
                      <a href="[% period_loo.script_name %]?op=delete_confirm&amp;budget_period_id=[% period_loo.budget_period_id %]">Delete</a>
381
                      <a href="[% script_name %]?op=delete_confirm&amp;budget_period_id=[% period_loo.budget_period_id %]">Delete</a>
382
                      <a href="[% script_name %]?op=duplicate_form&amp;budget_period_id=[% period_loo.budget_period_id %]">Duplicate</a>
381
                  <a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&amp;budget_period_id=[% period_loo.budget_period_id %]">Add fund</a>
383
                  <a href="/cgi-bin/koha/admin/aqbudgets.pl?op=add_form&amp;budget_period_id=[% period_loo.budget_period_id %]">Add fund</a>
382
                  </td>
384
                  </td>
383
                  </tr>
385
                  </tr>
(-)a/t/db_dependent/Budgets.t (-2 / +49 lines)
Lines 1-5 Link Here
1
use Modern::Perl;
1
use Modern::Perl;
2
use Test::More tests => 63;
2
use Test::More tests => 65;
3
3
4
BEGIN {
4
BEGIN {
5
    use_ok('C4::Budgets')
5
    use_ok('C4::Budgets')
Lines 352-354 for my $infos (@order_infos) { Link Here
352
is( GetBudgetHierarchySpent( $budget_id1 ), 160, "total spent for budget1 is 160" );
352
is( GetBudgetHierarchySpent( $budget_id1 ), 160, "total spent for budget1 is 160" );
353
is( GetBudgetHierarchySpent( $budget_id11 ), 100, "total spent for budget11 is 100" );
353
is( GetBudgetHierarchySpent( $budget_id11 ), 100, "total spent for budget11 is 100" );
354
is( GetBudgetHierarchySpent( $budget_id111 ), 20, "total spent for budget111 is 20" );
354
is( GetBudgetHierarchySpent( $budget_id111 ), 20, "total spent for budget111 is 20" );
355
- 
355
356
# CloneBudgetPeriod
357
my $budget_period_id_cloned = C4::Budgets::CloneBudgetPeriod(
358
    {
359
        budget_period_id        => $budget_period_id,
360
        budget_period_startdate => '2014-01-01',
361
        budget_period_enddate   => '2014-12-31',
362
    }
363
);
364
365
my $budget_hierarchy        = GetBudgetHierarchy($budget_period_id);
366
my $budget_hierarchy_cloned = GetBudgetHierarchy($budget_period_id_cloned);
367
368
is(
369
    scalar(@$budget_hierarchy_cloned),
370
    scalar(@$budget_hierarchy),
371
    'CloneBudgetPeriod clones the same number of budgets (funds)'
372
);
373
is_deeply(
374
    _get_dependencies($budget_hierarchy),
375
    _get_dependencies($budget_hierarchy_cloned),
376
    'CloneBudgetPeriod keep the same dependencies order'
377
);
378
379
sub _get_dependencies {
380
    my ($budget_hierarchy) = @_;
381
    my $graph;
382
    for my $budget (@$budget_hierarchy) {
383
        if ( $budget->{child} ) {
384
            my @sorted = sort @{ $budget->{child} };
385
            for my $child_id (@sorted) {
386
                push @{ $graph->{ $budget->{budget_name} }{children} },
387
                  _get_budgetname_by_id( $budget_hierarchy, $child_id );
388
            }
389
        }
390
        push @{ $graph->{ $budget->{budget_name} }{parents} },
391
          $budget->{parent_id};
392
    }
393
    return $graph;
394
}
395
396
sub _get_budgetname_by_id {
397
    my ( $budgets, $budget_id ) = @_;
398
    my ($budget_name) =
399
      map { ( $_->{budget_id} eq $budget_id ) ? $_->{budget_name} : () }
400
      @$budgets;
401
    return $budget_name;
402
}

Return to bug 12164