C4/Budgets.pm

   1 package C4::Budgets;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21 use JSON;
  22 use C4::Context;
  23 use Koha::Database;
  24 use Koha::Patrons;
  25 use Koha::Acquisition::Invoice::Adjustments;
  26 use C4::Acquisition;
  27 use C4::Log qw(logaction);
  28
  29 our (@ISA, @EXPORT_OK);
  30 BEGIN {
  31     require Exporter;
  32     @ISA       = qw(Exporter);
  33     @EXPORT_OK = qw(
  34
  35       GetBudget
  36       GetBudgetByOrderNumber
  37       GetBudgetByCode
  38       GetBudgets
  39       BudgetsByActivity
  40       GetBudgetsReport
  41       GetBudgetReport
  42       GetBudgetsByActivity
  43       GetBudgetHierarchy
  44       AddBudget
  45       ModBudget
  46       DelBudget
  47       GetBudgetSpent
  48       GetBudgetOrdered
  49       GetBudgetName
  50       GetPeriodsCount
  51       GetBudgetHierarchySpent
  52       GetBudgetHierarchyOrdered
  53
  54       GetBudgetUsers
  55       ModBudgetUsers
  56       CanUserUseBudget
  57       CanUserModifyBudget
  58
  59       GetBudgetPeriod
  60       GetBudgetPeriods
  61       ModBudgetPeriod
  62       AddBudgetPeriod
  63       DelBudgetPeriod
  64
  65       ModBudgetPlan
  66
  67       GetBudgetsPlanCell
  68       AddBudgetPlanValue
  69       GetBudgetAuthCats
  70       BudgetHasChildren
  71       GetBudgetChildren
  72       SetOwnerToFundHierarchy
  73       CheckBudgetParent
  74       CheckBudgetParentPerm
  75
  76       HideCols
  77       GetCols
  78
  79       CloneBudgetPeriod
  80       CloneBudgetHierarchy
  81       MoveOrders
  82     );
  83 }
  84
  85 # ----------------------------BUDGETS.PM-----------------------------";
  86
  87 =head1 FUNCTIONS ABOUT BUDGETS
  88
  89 =cut
  90
  91 sub HideCols {
  92     my ( $authcat, @hide_cols ) = @_;
  93     my $dbh = C4::Context->dbh;
  94
  95     my $sth1 = $dbh->prepare(
  96         qq|
  97         UPDATE aqbudgets_planning SET display = 0
  98         WHERE authcat = ?
  99         AND  authvalue = ? |
 100     );
 101     foreach my $authvalue (@hide_cols) {
 102 #        $sth1->{TraceLevel} = 3;
 103         $sth1->execute(  $authcat, $authvalue );
 104     }
 105 }
 106
 107 sub GetCols {
 108     my ( $authcat, $authvalue ) = @_;
 109
 110     my $dbh = C4::Context->dbh;
 111     my $sth = $dbh->prepare(
 112         qq|
 113         SELECT count(display) as cnt from aqbudgets_planning
 114         WHERE  authcat = ?
 115         AND authvalue = ? and display  = 0   |
 116     );
 117
 118 #    $sth->{TraceLevel} = 3;
 119     $sth->execute( $authcat, $authvalue );
 120     my $res  = $sth->fetchrow_hashref;
 121
 122     return  $res->{cnt} > 0 ? 0: 1
 123
 124 }
 125
 126 sub CheckBudgetParentPerm {
 127     my ( $budget, $borrower_id ) = @_;
 128     my $depth = $budget->{depth};
 129     my $parent_id = $budget->{budget_parent_id};
 130     while ($depth) {
 131         my $parent = GetBudget($parent_id);
 132         $parent_id = $parent->{budget_parent_id};
 133         if ( $parent->{budget_owner_id} == $borrower_id ) {
 134             return 1;
 135         }
 136         $depth--
 137     }
 138     return 0;
 139 }
 140
 141 sub AddBudgetPeriod {
 142     my ($budgetperiod) = @_;
 143     return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate});
 144
 145     undef $budgetperiod->{budget_period_id};
 146     my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
 147     return $resultset->create($budgetperiod)->id;
 148 }
 149 # -------------------------------------------------------------------
 150 sub GetPeriodsCount {
 151     my $dbh = C4::Context->dbh;
 152     my $sth = $dbh->prepare("
 153         SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
 154     $sth->execute();
 155     my $res = $sth->fetchrow_hashref;
 156     return $res->{'sum'};
 157 }
 158
 159 # -------------------------------------------------------------------
 160 sub CheckBudgetParent {
 161     my ( $new_parent, $budget ) = @_;
 162     my $new_parent_id = $new_parent->{'budget_id'};
 163     my $budget_id     = $budget->{'budget_id'};
 164     my $dbh           = C4::Context->dbh;
 165     my $parent_id_tmp = $new_parent_id;
 166
 167     # check new-parent is not a child (or a child's child ;)
 168     my $sth = $dbh->prepare(qq|
 169         SELECT budget_parent_id FROM
 170             aqbudgets where budget_id = ? | );
 171     while (1) {
 172         $sth->execute($parent_id_tmp);
 173         my $res = $sth->fetchrow_hashref;
 174         if ( $res->{'budget_parent_id'} == $budget_id ) {
 175             return 1;
 176         }
 177         if ( not defined $res->{'budget_parent_id'} ) {
 178             return 0;
 179         }
 180         $parent_id_tmp = $res->{'budget_parent_id'};
 181     }
 182 }
 183
 184 # -------------------------------------------------------------------
 185 sub BudgetHasChildren {
 186     my ( $budget_id  ) = @_;
 187     my $dbh = C4::Context->dbh;
 188     my $sth = $dbh->prepare(qq|
 189        SELECT count(*) as sum FROM  aqbudgets
 190         WHERE budget_parent_id = ?   | );
 191     $sth->execute( $budget_id );
 192     my $sum = $sth->fetchrow_hashref;
 193     return $sum->{'sum'};
 194 }
 195
 196 sub GetBudgetChildren {
 197     my ( $budget_id ) = @_;
 198     my $dbh = C4::Context->dbh;
 199     return $dbh->selectall_arrayref(q|
 200        SELECT  * FROM  aqbudgets
 201         WHERE budget_parent_id = ?
 202     |, { Slice => {} }, $budget_id );
 203 }
 204
 205 sub SetOwnerToFundHierarchy {
 206     my ( $budget_id, $borrowernumber ) = @_;
 207
 208     my $budget = GetBudget( $budget_id );
 209     $budget->{budget_owner_id} = $borrowernumber;
 210     ModBudget( $budget );
 211     my $children = GetBudgetChildren( $budget_id );
 212     for my $child ( @$children ) {
 213         SetOwnerToFundHierarchy( $child->{budget_id}, $borrowernumber );
 214     }
 215 }
 216
 217 # -------------------------------------------------------------------
 218 sub GetBudgetsPlanCell {
 219     my ( $cell, $period, $budget ) = @_; #FIXME we don't use $period
 220     my ($actual, $sth);
 221     my $dbh = C4::Context->dbh;
 222     my $roundsql = C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|);
 223     if ( $cell->{'authcat'} eq 'MONTHS' ) {
 224         # get the actual amount
 225         # FIXME we should consider quantity
 226         $sth = $dbh->prepare( qq|
 227
 228             SELECT SUM(| .  $roundsql . qq|) AS actual FROM aqorders
 229                 WHERE    budget_id = ? AND
 230                 entrydate like "$cell->{'authvalue'}%"  |
 231         );
 232         $sth->execute( $cell->{'budget_id'} );
 233     } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
 234         # get the actual amount
 235         # FIXME we should consider quantity
 236         $sth = $dbh->prepare( qq|
 237
 238             SELECT SUM(| . $roundsql . qq|) FROM aqorders
 239                 LEFT JOIN aqorders_items
 240                 ON (aqorders.ordernumber = aqorders_items.ordernumber)
 241                 LEFT JOIN items
 242                 ON (aqorders_items.itemnumber = items.itemnumber)
 243                 WHERE budget_id = ? AND homebranch = ? |          );
 244
 245         $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
 246     } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
 247         # get the actual amount
 248         $sth = $dbh->prepare(  qq|
 249
 250             SELECT SUM( | . $roundsql . qq| *  quantity) AS actual
 251                 FROM aqorders JOIN biblioitems
 252                 ON (biblioitems.biblionumber = aqorders.biblionumber )
 253                 WHERE aqorders.budget_id = ? and itemtype  = ? |
 254         );
 255         $sth->execute(  $cell->{'budget_id'},
 256                         $cell->{'authvalue'} );
 257     }
 258     # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
 259     else {
 260         # get the actual amount
 261         $sth = $dbh->prepare( qq|
 262
 263         SELECT  SUM(| . $roundsql . qq| * quantity) AS actual
 264             FROM aqorders
 265             JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
 266             WHERE  aqorders.budget_id = ? AND
 267                 ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
 268                 (aqbudgets.sort2_authcat = ? AND sort2 =?))    |
 269         );
 270         $sth->execute(  $cell->{'budget_id'},
 271                         $budget->{'sort1_authcat'},
 272                         $cell->{'authvalue'},
 273                         $budget->{'sort2_authcat'},
 274                         $cell->{'authvalue'}
 275         );
 276     }
 277     $actual = $sth->fetchrow_array;
 278
 279     # get the estimated amount
 280     $sth = $dbh->prepare( qq|
 281
 282         SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
 283             WHERE budget_period_id = ? AND
 284                 budget_id = ? AND
 285                 authvalue = ? AND
 286                 authcat = ?         |
 287     );
 288     $sth->execute(  $cell->{'budget_period_id'},
 289                     $cell->{'budget_id'},
 290                     $cell->{'authvalue'},
 291                     $cell->{'authcat'},
 292     );
 293
 294
 295     my $res  = $sth->fetchrow_hashref;
 296   #  my $display = $res->{'display'};
 297     my $estimated = $res->{'estimated'};
 298
 299
 300     return $actual, $estimated;
 301 }
 302
 303 # -------------------------------------------------------------------
 304 sub ModBudgetPlan {
 305     my ( $budget_plan, $budget_period_id, $authcat ) = @_;
 306     my $dbh = C4::Context->dbh;
 307     foreach my $buds (@$budget_plan) {
 308         my $lines = $buds->{lines};
 309         my $sth = $dbh->prepare( qq|
 310                 DELETE FROM aqbudgets_planning
 311                     WHERE   budget_period_id   = ? AND
 312                             budget_id   = ? AND
 313                             authcat            = ? |
 314         );
 315     #delete a aqplan line of cells, then insert new cells,
 316     # these could be UPDATES rather than DEL/INSERTS...
 317         $sth->execute( $budget_period_id,  $lines->[0]{budget_id}   , $authcat );
 318
 319         foreach my $cell (@$lines) {
 320             my $sth = $dbh->prepare( qq|
 321
 322                 INSERT INTO aqbudgets_planning
 323                      SET   budget_id     = ?,
 324                      budget_period_id  = ?,
 325                      authcat          = ?,
 326                      estimated_amount  = ?,
 327                      authvalue       = ?  |
 328             );
 329             $sth->execute(
 330                             $cell->{'budget_id'},
 331                             $cell->{'budget_period_id'},
 332                             $cell->{'authcat'},
 333                             $cell->{'estimated_amount'},
 334                             $cell->{'authvalue'},
 335             );
 336         }
 337     }
 338 }
 339
 340 # -------------------------------------------------------------------
 341 sub GetBudgetSpent {
 342     my ($budget_id) = @_;
 343     my $dbh = C4::Context->dbh;
 344     # unitprice_tax_included should always been set here
 345     # we should not need to retrieve ecost_tax_included
 346     my $sth = $dbh->prepare(qq|
 347         SELECT SUM( | . C4::Acquisition::get_rounding_sql("COALESCE(unitprice_tax_included, ecost_tax_included)") . qq| * quantity ) AS sum FROM aqorders
 348             WHERE budget_id = ? AND
 349             quantityreceived > 0 AND
 350             datecancellationprinted IS NULL
 351     |);
 352         $sth->execute($budget_id);
 353     my $sum = ( $sth->fetchrow_array || 0 ) + 0;
 354
 355     $sth = $dbh->prepare(qq|
 356         SELECT SUM(shipmentcost) AS sum
 357         FROM aqinvoices
 358         WHERE shipmentcost_budgetid = ?
 359     |);
 360
 361     $sth->execute($budget_id);
 362     my ($shipmentcost_sum) = $sth->fetchrow_array;
 363     $sum += ( $shipmentcost_sum || 0 ) + 0;
 364
 365     my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, closedate => { '!=' => undef } },{ join => 'invoiceid' });
 366     while ( my $adj = $adjustments->next ){
 367         $sum += $adj->adjustment;
 368     }
 369
 370         return $sum;
 371 }
 372
 373 # -------------------------------------------------------------------
 374 sub GetBudgetOrdered {
 375         my ($budget_id) = @_;
 376         my $dbh = C4::Context->dbh;
 377         my $sth = $dbh->prepare(qq|
 378         SELECT SUM(| . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . qq| *  quantity) AS sum FROM aqorders
 379             WHERE budget_id = ? AND
 380             quantityreceived = 0 AND
 381             datecancellationprinted IS NULL
 382     |);
 383         $sth->execute($budget_id);
 384     my $sum =  ( $sth->fetchrow_array || 0 ) + 0;
 385
 386     my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, encumber_open => 1, closedate => undef},{ join => 'invoiceid' });
 387     while ( my $adj = $adjustments->next ){
 388         $sum += $adj->adjustment;
 389     }
 390
 391         return $sum;
 392 }
 393
 394 =head2 GetBudgetName
 395
 396   my $budget_name = &GetBudgetName($budget_id);
 397
 398 get the budget_name for a given budget_id
 399
 400 =cut
 401
 402 sub GetBudgetName {
 403     my ( $budget_id ) = @_;
 404     my $dbh         = C4::Context->dbh;
 405     my $sth         = $dbh->prepare(
 406         qq|
 407         SELECT budget_name
 408         FROM aqbudgets
 409         WHERE budget_id = ?
 410     |);
 411
 412     $sth->execute($budget_id);
 413     return $sth->fetchrow_array;
 414 }
 415
 416 =head2 GetBudgetAuthCats
 417
 418   my $auth_cats = &GetBudgetAuthCats($budget_period_id);
 419
 420 Return the list of authcat for a given budget_period_id
 421
 422 =cut
 423
 424 sub GetBudgetAuthCats  {
 425     my ($budget_period_id) = shift;
 426     # now, populate the auth_cats_loop used in the budget planning button
 427     # we must retrieve all auth values used by at least one budget
 428     my $dbh = C4::Context->dbh;
 429     my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
 430     $sth->execute($budget_period_id);
 431     my %authcats;
 432     while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
 433         $authcats{$sort1_authcat}=1 if $sort1_authcat;
 434         $authcats{$sort2_authcat}=1 if $sort2_authcat;
 435     }
 436     return [ sort keys %authcats ];
 437 }
 438
 439 # -------------------------------------------------------------------
 440 sub GetBudgetPeriods {
 441         my ($filters,$orderby) = @_;
 442
 443     my $rs = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
 444     $rs = $rs->search( $filters, { order_by => $orderby } );
 445     $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 446     return [ $rs->all ];
 447 }
 448 # -------------------------------------------------------------------
 449 sub GetBudgetPeriod {
 450     my ($budget_period_id) = @_;
 451     my $dbh = C4::Context->dbh;
 452     my $sth = $dbh->prepare( qq|
 453         SELECT      *
 454         FROM aqbudgetperiods
 455         WHERE budget_period_id=? |
 456     );
 457     $sth->execute($budget_period_id);
 458     return $sth->fetchrow_hashref;
 459 }
 460
 461 sub DelBudgetPeriod{
 462         my ($budget_period_id) = @_;
 463         my $dbh = C4::Context->dbh;
 464           ; ## $total = number of records linked to the record that must be deleted
 465     my $total = 0;
 466
 467         ## get information about the record that will be deleted
 468         my $sth = $dbh->prepare(qq|
 469                 DELETE
 470          FROM aqbudgetperiods
 471          WHERE budget_period_id=? |
 472         );
 473         return $sth->execute($budget_period_id);
 474 }
 475
 476 # -------------------------------------------------------------------
 477 sub ModBudgetPeriod {
 478     my ($budget_period) = @_;
 479     my $result = Koha::Database->new()->schema->resultset('Aqbudgetperiod')->find($budget_period);
 480     return unless($result);
 481
 482     $result = $result->update($budget_period);
 483     return $result->in_storage;
 484 }
 485
 486 # -------------------------------------------------------------------
 487 sub GetBudgetHierarchy {
 488     my ( $budget_period_id, $branchcode, $owner, $skiptotals ) = @_;
 489     my @bind_params;
 490     my $dbh   = C4::Context->dbh;
 491     my $query = qq|
 492                     SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description,
 493                            b.firstname as budget_owner_firstname, b.surname as budget_owner_surname, b.borrowernumber as budget_owner_borrowernumber
 494                     FROM aqbudgets
 495                     LEFT JOIN borrowers b on b.borrowernumber = aqbudgets.budget_owner_id
 496                     JOIN aqbudgetperiods USING (budget_period_id)|;
 497
 498         my @where_strings;
 499     # show only period X if requested
 500     if ($budget_period_id) {
 501         push @where_strings," aqbudgets.budget_period_id = ?";
 502         push @bind_params, $budget_period_id;
 503     }
 504         # show only budgets owned by me, my branch or everyone
 505     if ($owner) {
 506         if ($branchcode) {
 507             push @where_strings,
 508             qq{ (budget_owner_id = ? OR budget_branchcode = ? OR ((budget_branchcode IS NULL or budget_branchcode="") AND (budget_owner_id IS NULL OR budget_owner_id="")))};
 509             push @bind_params, ( $owner, $branchcode );
 510         } else {
 511             push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") ';
 512             push @bind_params, $owner;
 513         }
 514     } else {
 515         if ($branchcode) {
 516             push @where_strings," (budget_branchcode =? or budget_branchcode is NULL OR budget_branchcode='')";
 517             push @bind_params, $branchcode;
 518         }
 519     }
 520         $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
 521         my $sth = $dbh->prepare($query);
 522         $sth->execute(@bind_params);
 523
 524     my %links;
 525     # create hash with budget_id has key
 526     while ( my $data = $sth->fetchrow_hashref ) {
 527         $links{ $data->{'budget_id'} } = $data;
 528     }
 529
 530     # link child to parent
 531     my @first_parents;
 532     foreach my $budget ( sort { $a->{budget_code} cmp $b->{budget_code} } values %links ) {
 533         my $child = $links{$budget->{budget_id}};
 534         if ( $child->{'budget_parent_id'} ) {
 535             my $parent = $links{ $child->{'budget_parent_id'} };
 536             if ($parent) {
 537                 unless ( $parent->{'children'} ) {
 538                     # init child arrayref
 539                     $parent->{'children'} = [];
 540                 }
 541                 # add as child
 542                 push @{ $parent->{'children'} }, $child;
 543             }
 544         } else {
 545             push @first_parents, $child;
 546         }
 547     }
 548
 549     my @sort = ();
 550     foreach my $first_parent (@first_parents) {
 551         _add_budget_children(\@sort, $first_parent, 0);
 552     }
 553     if (!$skiptotals) {
 554         # Get all the budgets totals in as few queries as possible
 555         my $hr_budget_spent = $dbh->selectall_hashref(q|
 556             SELECT aqorders.budget_id, aqbudgets.budget_parent_id,
 557                 SUM( | . C4::Acquisition::get_rounding_sql(qq|COALESCE(unitprice_tax_included, ecost_tax_included)|) . q| * quantity ) AS budget_spent
 558             FROM aqorders JOIN aqbudgets USING (budget_id)
 559             WHERE quantityreceived > 0 AND datecancellationprinted IS NULL
 560             GROUP BY budget_id, budget_parent_id
 561             |, 'budget_id');
 562         my $hr_budget_ordered = $dbh->selectall_hashref(q|
 563             SELECT aqorders.budget_id, aqbudgets.budget_parent_id,
 564                 SUM( | . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . q| *  quantity) AS budget_ordered
 565             FROM aqorders JOIN aqbudgets USING (budget_id)
 566             WHERE quantityreceived = 0 AND datecancellationprinted IS NULL
 567             GROUP BY budget_id, budget_parent_id
 568             |, 'budget_id');
 569         my $hr_budget_spent_shipment = $dbh->selectall_hashref(q|
 570             SELECT shipmentcost_budgetid as budget_id,
 571                 SUM(shipmentcost) as shipmentcost
 572             FROM aqinvoices
 573             GROUP BY shipmentcost_budgetid
 574             |, 'budget_id');
 575         my $hr_budget_spent_adjustment = $dbh->selectall_hashref(q|
 576             SELECT budget_id,
 577                 SUM(adjustment) as adjustments
 578             FROM aqinvoice_adjustments
 579             JOIN aqinvoices USING (invoiceid)
 580             WHERE closedate IS NOT NULL
 581             GROUP BY budget_id
 582             |, 'budget_id');
 583         my $hr_budget_ordered_adjustment = $dbh->selectall_hashref(q|
 584             SELECT budget_id,
 585                 SUM(adjustment) as adjustments
 586             FROM aqinvoice_adjustments
 587             JOIN aqinvoices USING (invoiceid)
 588             WHERE closedate IS NULL AND encumber_open = 1
 589             GROUP BY budget_id
 590             |, 'budget_id');
 591
 592
 593         foreach my $budget (@sort) {
 594             if ( not defined $budget->{budget_parent_id} ) {
 595                 _recursiveAdd( $budget, undef, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment );
 596             }
 597         }
 598     }
 599     return \@sort;
 600 }
 601
 602 sub _recursiveAdd {
 603     my ($budget, $parent, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ) = @_;
 604
 605     foreach my $child (@{$budget->{children}}){
 606         _recursiveAdd($child, $budget, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment );
 607     }
 608
 609     $budget->{budget_spent} += $hr_budget_spent->{$budget->{budget_id}}->{budget_spent}               || 0;
 610     $budget->{budget_spent} += $hr_budget_spent_shipment->{$budget->{budget_id}}->{shipmentcost}      || 0;
 611     $budget->{budget_spent} += $hr_budget_spent_adjustment->{$budget->{budget_id}}->{adjustments}     || 0;
 612     $budget->{budget_ordered} += $hr_budget_ordered->{$budget->{budget_id}}->{budget_ordered}         || 0;
 613     $budget->{budget_ordered} += $hr_budget_ordered_adjustment->{$budget->{budget_id}}->{adjustments} || 0;
 614
 615     $budget->{total_spent} += $budget->{budget_spent};
 616     $budget->{total_ordered} += $budget->{budget_ordered};
 617
 618     if ($parent) {
 619         $parent->{total_spent} += $budget->{total_spent};
 620         $parent->{total_ordered} += $budget->{total_ordered};
 621     }
 622 }
 623
 624 # Recursive method to add a budget and its chidren to an array
 625 sub _add_budget_children {
 626     my $res = shift;
 627     my $budget = shift;
 628     $budget->{budget_level} = shift;
 629     push @$res, $budget;
 630     my $children = $budget->{'children'} || [];
 631     return unless @$children; # break recursivity
 632     foreach my $child (@$children) {
 633         _add_budget_children($res, $child, $budget->{budget_level} + 1);
 634     }
 635 }
 636
 637 # -------------------------------------------------------------------
 638 # FIXME Must be replaced by Koha::Acquisition::Fund->store
 639 sub AddBudget {
 640     my ($budget) = @_;
 641     return unless ($budget);
 642
 643     undef $budget->{budget_encumb}   if defined $budget->{budget_encumb}   && $budget->{budget_encumb}   eq '';
 644     undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq '';
 645     my $resultset = Koha::Database->new()->schema->resultset('Aqbudget');
 646     my $id = $resultset->create($budget)->id;
 647
 648     # Log the addition
 649     if (C4::Context->preference("AcquisitionLog")) {
 650         my $infos = {
 651             budget_amount => $budget->{budget_amount},
 652             budget_encumb => $budget->{budget_encumb},
 653             budget_expend => $budget->{budget_expend}
 654         };
 655         logaction(
 656             'ACQUISITIONS',
 657             'CREATE_FUND',
 658             $id,
 659             encode_json($infos)
 660         );
 661     }
 662     return $id;
 663 }
 664
 665 # -------------------------------------------------------------------
 666 # FIXME Must be replaced by Koha::Acquisition::Fund->store
 667 sub ModBudget {
 668     my ($budget) = @_;
 669     my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget);
 670     return unless($result);
 671
 672     # Log this modification
 673     if (C4::Context->preference("AcquisitionLog")) {
 674         my $infos = {
 675             budget_amount_new    => $budget->{budget_amount},
 676             budget_encumb_new    => $budget->{budget_encumb},
 677             budget_expend_new    => $budget->{budget_expend},
 678             budget_amount_old    => $result->budget_amount,
 679             budget_encumb_old    => $result->budget_encumb,
 680             budget_expend_old    => $result->budget_expend,
 681             budget_amount_change => 0 - ($result->budget_amount - $budget->{budget_amount})
 682         };
 683         logaction(
 684             'ACQUISITIONS',
 685             'MODIFY_FUND',
 686             $budget->{budget_id},
 687             encode_json($infos)
 688         );
 689     }
 690
 691     undef $budget->{budget_encumb}   if defined $budget->{budget_encumb}   && $budget->{budget_encumb}   eq '';
 692     undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq '';
 693     $result = $result->update($budget);
 694     return $result->in_storage;
 695 }
 696
 697 # -------------------------------------------------------------------
 698 # FIXME Must be replaced by Koha::Acquisition::Fund->delete
 699 sub DelBudget {
 700         my ($budget_id) = @_;
 701         my $dbh         = C4::Context->dbh;
 702         my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
 703         my $rc          = $sth->execute($budget_id);
 704     # Log the deletion
 705     if (C4::Context->preference("AcquisitionLog")) {
 706         logaction(
 707             'ACQUISITIONS',
 708             'DELETE_FUND',
 709             $budget_id
 710         );
 711     }
 712         return $rc;
 713 }
 714
 715
 716 # -------------------------------------------------------------------
 717
 718 =head2 GetBudget
 719
 720   &GetBudget($budget_id);
 721
 722 get a specific budget
 723
 724 =cut
 725
 726 sub GetBudget {
 727     my ( $budget_id ) = @_;
 728     my $dbh = C4::Context->dbh;
 729     my $query = "
 730         SELECT *
 731         FROM   aqbudgets
 732         WHERE  budget_id=?
 733         ";
 734     my $sth = $dbh->prepare($query);
 735     $sth->execute( $budget_id );
 736     my $result = $sth->fetchrow_hashref;
 737     return $result;
 738 }
 739
 740 # -------------------------------------------------------------------
 741
 742 =head2 GetBudgetByOrderNumber
 743
 744   &GetBudgetByOrderNumber($ordernumber);
 745
 746 get a specific budget by order number
 747
 748 =cut
 749
 750 sub GetBudgetByOrderNumber {
 751     my ( $ordernumber ) = @_;
 752     my $dbh = C4::Context->dbh;
 753     my $query = "
 754         SELECT aqbudgets.*
 755         FROM   aqbudgets, aqorders
 756         WHERE  ordernumber=?
 757         AND    aqorders.budget_id = aqbudgets.budget_id
 758         ";
 759     my $sth = $dbh->prepare($query);
 760     $sth->execute( $ordernumber );
 761     my $result = $sth->fetchrow_hashref;
 762     return $result;
 763 }
 764
 765 =head2 GetBudgetReport
 766
 767   &GetBudgetReport( [$budget_id] );
 768
 769 Get all orders for a specific budget, without cancelled orders.
 770
 771 Returns an array of hashrefs.
 772
 773 =cut
 774
 775 # --------------------------------------------------------------------
 776 sub GetBudgetReport {
 777     my ( $budget_id ) = @_;
 778     my $dbh = C4::Context->dbh;
 779     my $query = '
 780         SELECT o.*, b.budget_name
 781         FROM   aqbudgets b
 782         INNER JOIN aqorders o
 783         ON b.budget_id = o.budget_id
 784         WHERE  b.budget_id=?
 785         AND (o.orderstatus != "cancelled")
 786         ORDER BY b.budget_name';
 787
 788     my $sth = $dbh->prepare($query);
 789     $sth->execute( $budget_id );
 790
 791     my @results = ();
 792     while ( my $data = $sth->fetchrow_hashref ) {
 793         push( @results, $data );
 794     }
 795     return @results;
 796 }
 797
 798 =head2 GetBudgetsByActivity
 799
 800   &GetBudgetsByActivity( $budget_period_active );
 801
 802 Get all active or inactive budgets, depending of the value
 803 of the parameter.
 804
 805 1 = active
 806 0 = inactive
 807
 808 =cut
 809
 810 # --------------------------------------------------------------------
 811 sub GetBudgetsByActivity {
 812     my ( $budget_period_active ) = @_;
 813     my $dbh = C4::Context->dbh;
 814     my $query = "
 815         SELECT DISTINCT b.*
 816         FROM   aqbudgetperiods bp
 817         INNER JOIN aqbudgets b
 818         ON bp.budget_period_id = b.budget_period_id
 819         WHERE  bp.budget_period_active=?
 820         ";
 821     my $sth = $dbh->prepare($query);
 822     $sth->execute( $budget_period_active );
 823     my @results = ();
 824     while ( my $data = $sth->fetchrow_hashref ) {
 825         push( @results, $data );
 826     }
 827     return @results;
 828 }
 829 # --------------------------------------------------------------------
 830
 831 =head2 GetBudgetsReport
 832
 833   &GetBudgetsReport( [$activity] );
 834
 835 Get all but cancelled orders for all funds.
 836
 837 If the optionnal activity parameter is passed, returns orders for active/inactive budgets only.
 838
 839 active = 1
 840 inactive = 0
 841
 842 Returns an array of hashrefs.
 843
 844 =cut
 845
 846 sub GetBudgetsReport {
 847     my ($activity) = @_;
 848     my $dbh = C4::Context->dbh;
 849     my $query = '
 850         SELECT o.*, b.budget_name
 851         FROM   aqbudgetperiods bp
 852         INNER JOIN aqbudgets b
 853         ON bp.budget_period_id = b.budget_period_id
 854         INNER JOIN aqorders o
 855         ON b.budget_id = o.budget_id ';
 856     if ( $activity && $activity ne '' ) {
 857         $query .= 'WHERE  bp.budget_period_active=? ';
 858     }
 859     $query .= 'AND (o.orderstatus != "cancelled")
 860                ORDER BY b.budget_name';
 861
 862     my $sth = $dbh->prepare($query);
 863     if ( $activity && $activity ne '' ) {
 864         $sth->execute($activity);
 865     }
 866     else{
 867         $sth->execute;
 868     }
 869     my @results = ();
 870     while ( my $data = $sth->fetchrow_hashref ) {
 871         push( @results, $data );
 872     }
 873     return @results;
 874 }
 875
 876 =head2 GetBudgetByCode
 877
 878     my $budget = &GetBudgetByCode($budget_code);
 879
 880 Retrieve all aqbudgets fields as a hashref for the budget that has
 881 given budget_code
 882
 883 =cut
 884
 885 sub GetBudgetByCode {
 886     my ( $budget_code ) = @_;
 887
 888     my $dbh = C4::Context->dbh;
 889     my $query = qq{
 890         SELECT aqbudgets.*
 891         FROM aqbudgets
 892         JOIN aqbudgetperiods USING (budget_period_id)
 893         WHERE budget_code = ?
 894         ORDER BY budget_period_active DESC, budget_id DESC
 895         LIMIT 1
 896     };
 897     my $sth = $dbh->prepare( $query );
 898     $sth->execute( $budget_code );
 899     return $sth->fetchrow_hashref;
 900 }
 901
 902 =head2 GetBudgetHierarchySpent
 903
 904   my $spent = GetBudgetHierarchySpent( $budget_id );
 905
 906 Gets the total spent of the level and sublevels of $budget_id
 907
 908 =cut
 909
 910 sub GetBudgetHierarchySpent {
 911     my ( $budget_id ) = @_;
 912     my $dbh = C4::Context->dbh;
 913     my $children_ids = $dbh->selectcol_arrayref(q|
 914         SELECT budget_id
 915         FROM   aqbudgets
 916         WHERE  budget_parent_id = ?
 917     |, {}, $budget_id );
 918
 919     my $total_spent = GetBudgetSpent( $budget_id );
 920     for my $child_id ( @$children_ids ) {
 921         $total_spent += GetBudgetHierarchySpent( $child_id );
 922     }
 923     return $total_spent;
 924 }
 925
 926 =head2 GetBudgetHierarchyOrdered
 927
 928   my $ordered = GetBudgetHierarchyOrdered( $budget_id );
 929
 930 Gets the total ordered of the level and sublevels of $budget_id
 931
 932 =cut
 933
 934 sub GetBudgetHierarchyOrdered {
 935     my ( $budget_id ) = @_;
 936     my $dbh = C4::Context->dbh;
 937     my $children_ids = $dbh->selectcol_arrayref(q|
 938         SELECT budget_id
 939         FROM   aqbudgets
 940         WHERE  budget_parent_id = ?
 941     |, {}, $budget_id );
 942
 943     my $total_ordered = GetBudgetOrdered( $budget_id );
 944     for my $child_id ( @$children_ids ) {
 945         $total_ordered += GetBudgetHierarchyOrdered( $child_id );
 946     }
 947     return $total_ordered;
 948 }
 949
 950 =head2 GetBudgets
 951
 952   &GetBudgets($filter, $order_by);
 953
 954 gets all budgets
 955
 956 =cut
 957
 958 # -------------------------------------------------------------------
 959 sub GetBudgets {
 960     my ($filters, $orderby) = @_;
 961     $orderby = 'budget_name' unless($orderby);
 962
 963     my $rs = Koha::Database->new()->schema->resultset('Aqbudget');
 964     $rs = $rs->search( $filters, { order_by => $orderby } );
 965     $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 966     return [ $rs->all  ];
 967 }
 968
 969 =head2 GetBudgetUsers
 970
 971     my @borrowernumbers = &GetBudgetUsers($budget_id);
 972
 973 Return the list of borrowernumbers linked to a budget
 974
 975 =cut
 976
 977 sub GetBudgetUsers {
 978     my ($budget_id) = @_;
 979
 980     my $dbh = C4::Context->dbh;
 981     my $query = qq{
 982         SELECT borrowernumber
 983         FROM aqbudgetborrowers
 984         WHERE budget_id = ?
 985     };
 986     my $sth = $dbh->prepare($query);
 987     $sth->execute($budget_id);
 988
 989     my @borrowernumbers;
 990     while (my ($borrowernumber) = $sth->fetchrow_array) {
 991         push @borrowernumbers, $borrowernumber
 992     }
 993
 994     return @borrowernumbers;
 995 }
 996
 997 =head2 ModBudgetUsers
 998
 999     &ModBudgetUsers($budget_id, @borrowernumbers);
1000
1001 Modify the list of borrowernumbers linked to a budget
1002
1003 =cut
1004
1005 sub ModBudgetUsers {
1006     my ($budget_id, @budget_users_id) = @_;
1007
1008     return unless $budget_id;
1009
1010     my $dbh = C4::Context->dbh;
1011     my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
1012     my $sth = $dbh->prepare($query);
1013     $sth->execute($budget_id);
1014
1015     $query = qq{
1016         INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
1017         VALUES (?,?)
1018     };
1019     $sth = $dbh->prepare($query);
1020     foreach my $borrowernumber (@budget_users_id) {
1021         next unless $borrowernumber;
1022         $sth->execute($budget_id, $borrowernumber);
1023     }
1024 }
1025
1026 sub CanUserUseBudget {
1027     my ($borrower, $budget, $userflags) = @_;
1028
1029     if (not ref $borrower) {
1030         $borrower = Koha::Patrons->find( $borrower );
1031         return 0 unless $borrower;
1032         $borrower = $borrower->unblessed;
1033     }
1034     if (not ref $budget) {
1035         $budget = GetBudget($budget);
1036     }
1037
1038     return 0 unless ($borrower and $budget);
1039
1040     if (not defined $userflags) {
1041         $userflags = C4::Auth::getuserflags($borrower->{flags},
1042             $borrower->{userid});
1043     }
1044
1045     unless ($userflags->{superlibrarian}
1046     || (ref $userflags->{acquisition}
1047         && $userflags->{acquisition}->{budget_manage_all})
1048     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
1049     {
1050         if (not exists $userflags->{acquisition}) {
1051             return 0;
1052         }
1053
1054         if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
1055             return 0;
1056         }
1057
1058         # Budget restricted to owner
1059         if ( $budget->{budget_permission} == 1 ) {
1060             if (    $budget->{budget_owner_id}
1061                 and $budget->{budget_owner_id} != $borrower->{borrowernumber} )
1062             {
1063                 return 0;
1064             }
1065         }
1066
1067         # Budget restricted to owner, users and library
1068         elsif ( $budget->{budget_permission} == 2 ) {
1069             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
1070
1071             if (
1072                 (
1073                         $budget->{budget_owner_id}
1074                     and $budget->{budget_owner_id} !=
1075                     $borrower->{borrowernumber}
1076                     or not $budget->{budget_owner_id}
1077                 )
1078                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
1079                     @budget_users )
1080                 and defined $budget->{budget_branchcode}
1081                 and $budget->{budget_branchcode} ne
1082                 C4::Context->userenv->{branch}
1083               )
1084             {
1085                 return 0;
1086             }
1087         }
1088
1089         # Budget restricted to owner and users
1090         elsif ( $budget->{budget_permission} == 3 ) {
1091             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
1092             if (
1093                 (
1094                         $budget->{budget_owner_id}
1095                     and $budget->{budget_owner_id} !=
1096                     $borrower->{borrowernumber}
1097                     or not $budget->{budget_owner_id}
1098                 )
1099                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
1100                     @budget_users )
1101               )
1102             {
1103                 return 0;
1104             }
1105         }
1106     }
1107
1108     return 1;
1109 }
1110
1111 sub CanUserModifyBudget {
1112     my ($borrower, $budget, $userflags) = @_;
1113
1114     if (not ref $borrower) {
1115         $borrower = Koha::Patrons->find( $borrower );
1116         return 0 unless $borrower;
1117         $borrower = $borrower->unblessed;
1118     }
1119     if (not ref $budget) {
1120         $budget = GetBudget($budget);
1121     }
1122
1123     return 0 unless ($borrower and $budget);
1124
1125     if (not defined $userflags) {
1126         $userflags = C4::Auth::getuserflags($borrower->{flags},
1127             $borrower->{userid});
1128     }
1129
1130     unless ($userflags->{superlibrarian}
1131     || (ref $userflags->{acquisition}
1132         && $userflags->{acquisition}->{budget_manage_all})
1133     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
1134     {
1135         if (!CanUserUseBudget($borrower, $budget, $userflags)) {
1136             return 0;
1137         }
1138
1139         if (ref $userflags->{acquisition}
1140         && !$userflags->{acquisition}->{budget_modify}) {
1141             return 0;
1142         }
1143     }
1144
1145     return 1;
1146 }
1147
1148 sub _round {
1149     my ($value, $increment) = @_;
1150
1151     if ($increment && $increment != 0) {
1152         $value = int($value / $increment) * $increment;
1153     }
1154
1155     return $value;
1156 }
1157
1158 =head2 CloneBudgetPeriod
1159
1160   my $new_budget_period_id = CloneBudgetPeriod({
1161     budget_period_id => $budget_period_id,
1162     budget_period_startdate => $budget_period_startdate,
1163     budget_period_enddate   => $budget_period_enddate,
1164     mark_original_budget_as_inactive => 1n
1165     reset_all_budgets => 1,
1166   });
1167
1168 Clone a budget period with all budgets.
1169 If the mark_origin_budget_as_inactive is set (0 by default),
1170 the original budget will be marked as inactive.
1171
1172 If the reset_all_budgets is set (0 by default), all budget (fund)
1173 amounts will be reset.
1174
1175 =cut
1176
1177 sub CloneBudgetPeriod {
1178     my ($params)                  = @_;
1179     my $budget_period_id          = $params->{budget_period_id};
1180     my $budget_period_startdate   = $params->{budget_period_startdate};
1181     my $budget_period_enddate     = $params->{budget_period_enddate};
1182     my $budget_period_description = $params->{budget_period_description};
1183     my $amount_change_percentage  = $params->{amount_change_percentage};
1184     my $amount_change_round_increment = $params->{amount_change_round_increment};
1185     my $mark_original_budget_as_inactive =
1186       $params->{mark_original_budget_as_inactive} || 0;
1187     my $reset_all_budgets = $params->{reset_all_budgets} || 0;
1188
1189     my $budget_period = GetBudgetPeriod($budget_period_id);
1190
1191     $budget_period->{budget_period_startdate}   = $budget_period_startdate;
1192     $budget_period->{budget_period_enddate}     = $budget_period_enddate;
1193     $budget_period->{budget_period_description} = $budget_period_description;
1194     # The new budget (budget_period) should be active by default
1195     $budget_period->{budget_period_active}    = 1;
1196
1197     if ($amount_change_percentage) {
1198         my $total = $budget_period->{budget_period_total};
1199         $total += $total * $amount_change_percentage / 100;
1200         $total = _round($total, $amount_change_round_increment);
1201         $budget_period->{budget_period_total} = $total;
1202     }
1203
1204     my $original_budget_period_id = $budget_period->{budget_period_id};
1205     delete $budget_period->{budget_period_id};
1206     my $new_budget_period_id = AddBudgetPeriod( $budget_period );
1207
1208     my $budgets = GetBudgetHierarchy($budget_period_id);
1209     CloneBudgetHierarchy(
1210         {
1211             budgets              => $budgets,
1212             new_budget_period_id => $new_budget_period_id
1213         }
1214     );
1215
1216     if ($mark_original_budget_as_inactive) {
1217         ModBudgetPeriod(
1218             {
1219                 budget_period_id     => $budget_period_id,
1220                 budget_period_active => 0,
1221             }
1222         );
1223     }
1224
1225     if ( $reset_all_budgets ) {
1226         my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1227         for my $budget ( @$budgets ) {
1228             $budget->{budget_amount} = 0;
1229             ModBudget( $budget );
1230         }
1231     } elsif ($amount_change_percentage) {
1232         my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1233         for my $budget ( @$budgets ) {
1234             my $amount = $budget->{budget_amount};
1235             $amount += $amount * $amount_change_percentage / 100;
1236             $amount = _round($amount, $amount_change_round_increment);
1237             $budget->{budget_amount} = $amount;
1238             ModBudget( $budget );
1239         }
1240     }
1241
1242     return $new_budget_period_id;
1243 }
1244
1245 =head2 CloneBudgetHierarchy
1246
1247   CloneBudgetHierarchy({
1248     budgets => $budgets,
1249     new_budget_period_id => $new_budget_period_id;
1250   });
1251
1252 Clone a budget hierarchy.
1253
1254 =cut
1255
1256 sub CloneBudgetHierarchy {
1257     my ($params)             = @_;
1258     my $budgets              = $params->{budgets};
1259     my $new_budget_period_id = $params->{new_budget_period_id};
1260     next unless @$budgets or $new_budget_period_id;
1261
1262     my $children_of   = $params->{children_of};
1263     my $new_parent_id = $params->{new_parent_id};
1264
1265     my @first_level_budgets =
1266       ( not defined $children_of )
1267       ? map { ( not $_->{budget_parent_id} )             ? $_ : () } @$budgets
1268       : map { ( defined $_->{budget_parent_id} && $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;
1269
1270     # get only the columns of aqbudgets
1271     my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
1272
1273     for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
1274         @first_level_budgets )
1275     {
1276
1277         my $tidy_budget =
1278           { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
1279               keys %$budget };
1280         delete $tidy_budget->{timestamp};
1281         my $new_budget_id = AddBudget(
1282             {
1283                 %$tidy_budget,
1284                 budget_id        => undef,
1285                 budget_parent_id => $new_parent_id,
1286                 budget_period_id => $new_budget_period_id
1287             }
1288         );
1289         my @borrowernumbers = GetBudgetUsers($budget->{budget_id});
1290         ModBudgetUsers($new_budget_id, @borrowernumbers);
1291         CloneBudgetHierarchy(
1292             {
1293                 budgets              => $budgets,
1294                 new_budget_period_id => $new_budget_period_id,
1295                 children_of          => $budget->{budget_id},
1296                 new_parent_id        => $new_budget_id
1297             }
1298         );
1299     }
1300 }
1301
1302 =head2 MoveOrders
1303
1304   my $report = MoveOrders({
1305     from_budget_period_id => $from_budget_period_id,
1306     to_budget_period_id   => $to_budget_period_id,
1307   });
1308
1309 Move orders from one budget period to another.
1310
1311 =cut
1312
1313 sub MoveOrders {
1314     my ($params)              = @_;
1315     my $from_budget_period_id = $params->{from_budget_period_id};
1316     my $to_budget_period_id   = $params->{to_budget_period_id};
1317     my $move_remaining_unspent = $params->{move_remaining_unspent};
1318     return
1319       if not $from_budget_period_id
1320           or not $to_budget_period_id
1321           or $from_budget_period_id == $to_budget_period_id;
1322
1323     # Can't move orders to an inactive budget (budgetperiod)
1324     my $budget_period = GetBudgetPeriod($to_budget_period_id);
1325     return unless $budget_period->{budget_period_active};
1326
1327     my @report;
1328     my $dbh     = C4::Context->dbh;
1329     my $sth_update_aqorders = $dbh->prepare(
1330         q|
1331             UPDATE aqorders
1332             SET budget_id = ?
1333             WHERE ordernumber = ?
1334         |
1335     );
1336     my $sth_update_budget_amount = $dbh->prepare(
1337         q|
1338             UPDATE aqbudgets
1339             SET budget_amount = ?
1340             WHERE budget_id = ?
1341         |
1342     );
1343     my $from_budgets = GetBudgetHierarchy($from_budget_period_id);
1344     for my $from_budget (@$from_budgets) {
1345         my $new_budget_id = $dbh->selectcol_arrayref(
1346             q|
1347                 SELECT budget_id
1348                 FROM aqbudgets
1349                 WHERE budget_period_id = ?
1350                     AND budget_code = ?
1351             |, {}, $to_budget_period_id, $from_budget->{budget_code}
1352         );
1353         $new_budget_id = $new_budget_id->[0];
1354         my $new_budget = GetBudget( $new_budget_id );
1355         unless ( $new_budget ) {
1356             push @report,
1357               {
1358                 moved       => 0,
1359                 budget      => $from_budget,
1360                 error       => 'budget_code_not_exists',
1361               };
1362             next;
1363         }
1364         my $orders_to_move = C4::Acquisition::SearchOrders(
1365             {
1366                 budget_id => $from_budget->{budget_id},
1367                 pending   => 1,
1368             }
1369         );
1370
1371         my @orders_moved;
1372         for my $order (@$orders_to_move) {
1373             $sth_update_aqorders->execute( $new_budget->{budget_id}, $order->{ordernumber} );
1374             push @orders_moved, $order;
1375         }
1376
1377         my $unspent_moved = 0;
1378         if ($move_remaining_unspent) {
1379             my $spent   = GetBudgetHierarchySpent( $from_budget->{budget_id} );
1380             my $unspent = $from_budget->{budget_amount} - $spent;
1381             my $new_budget_amount = $new_budget->{budget_amount};
1382             if ( $unspent > 0 ) {
1383                 $new_budget_amount += $unspent;
1384                 $unspent_moved = $unspent;
1385             }
1386             $new_budget->{budget_amount} = $new_budget_amount;
1387             $sth_update_budget_amount->execute( $new_budget_amount,
1388                 $new_budget->{budget_id} );
1389         }
1390
1391         push @report,
1392           {
1393             budget        => $new_budget,
1394             orders_moved  => \@orders_moved,
1395             moved         => 1,
1396             unspent_moved => $unspent_moved,
1397           };
1398     }
1399     return \@report;
1400 }
1401
1402 END { }    # module clean-up code here (global destructor)
1403
1404 1;
1405 __END__
1406
1407 =head1 AUTHOR
1408
1409 Koha Development Team <http://koha-community.org/>
1410
1411 =cut