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 ) = @_;
 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
 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     return \@sort;
 599 }
 600
 601 sub _recursiveAdd {
 602     my ($budget, $parent, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ) = @_;
 603
 604     foreach my $child (@{$budget->{children}}){
 605         _recursiveAdd($child, $budget, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment );
 606     }
 607
 608     $budget->{budget_spent} += $hr_budget_spent->{$budget->{budget_id}}->{budget_spent}               || 0;
 609     $budget->{budget_spent} += $hr_budget_spent_shipment->{$budget->{budget_id}}->{shipmentcost}      || 0;
 610     $budget->{budget_spent} += $hr_budget_spent_adjustment->{$budget->{budget_id}}->{adjustments}     || 0;
 611     $budget->{budget_ordered} += $hr_budget_ordered->{$budget->{budget_id}}->{budget_ordered}         || 0;
 612     $budget->{budget_ordered} += $hr_budget_ordered_adjustment->{$budget->{budget_id}}->{adjustments} || 0;
 613
 614     $budget->{total_spent} += $budget->{budget_spent};
 615     $budget->{total_ordered} += $budget->{budget_ordered};
 616
 617     if ($parent) {
 618         $parent->{total_spent} += $budget->{total_spent};
 619         $parent->{total_ordered} += $budget->{total_ordered};
 620     }
 621 }
 622
 623 # Recursive method to add a budget and its chidren to an array
 624 sub _add_budget_children {
 625     my $res = shift;
 626     my $budget = shift;
 627     $budget->{budget_level} = shift;
 628     push @$res, $budget;
 629     my $children = $budget->{'children'} || [];
 630     return unless @$children; # break recursivity
 631     foreach my $child (@$children) {
 632         _add_budget_children($res, $child, $budget->{budget_level} + 1);
 633     }
 634 }
 635
 636 # -------------------------------------------------------------------
 637 # FIXME Must be replaced by Koha::Acquisition::Fund->store
 638 sub AddBudget {
 639     my ($budget) = @_;
 640     return unless ($budget);
 641
 642     undef $budget->{budget_encumb}   if defined $budget->{budget_encumb}   && $budget->{budget_encumb}   eq '';
 643     undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq '';
 644     my $resultset = Koha::Database->new()->schema->resultset('Aqbudget');
 645     my $id = $resultset->create($budget)->id;
 646
 647     # Log the addition
 648     if (C4::Context->preference("AcquisitionLog")) {
 649         my $infos = {
 650             budget_amount => $budget->{budget_amount},
 651             budget_encumb => $budget->{budget_encumb},
 652             budget_expend => $budget->{budget_expend}
 653         };
 654         logaction(
 655             'ACQUISITIONS',
 656             'CREATE_FUND',
 657             $id,
 658             encode_json($infos)
 659         );
 660     }
 661     return $id;
 662 }
 663
 664 # -------------------------------------------------------------------
 665 # FIXME Must be replaced by Koha::Acquisition::Fund->store
 666 sub ModBudget {
 667     my ($budget) = @_;
 668     my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget);
 669     return unless($result);
 670
 671     # Log this modification
 672     if (C4::Context->preference("AcquisitionLog")) {
 673         my $infos = {
 674             budget_amount_new    => $budget->{budget_amount},
 675             budget_encumb_new    => $budget->{budget_encumb},
 676             budget_expend_new    => $budget->{budget_expend},
 677             budget_amount_old    => $result->budget_amount,
 678             budget_encumb_old    => $result->budget_encumb,
 679             budget_expend_old    => $result->budget_expend,
 680             budget_amount_change => 0 - ($result->budget_amount - $budget->{budget_amount})
 681         };
 682         logaction(
 683             'ACQUISITIONS',
 684             'MODIFY_FUND',
 685             $budget->{budget_id},
 686             encode_json($infos)
 687         );
 688     }
 689
 690     undef $budget->{budget_encumb}   if defined $budget->{budget_encumb}   && $budget->{budget_encumb}   eq '';
 691     undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq '';
 692     $result = $result->update($budget);
 693     return $result->in_storage;
 694 }
 695
 696 # -------------------------------------------------------------------
 697 # FIXME Must be replaced by Koha::Acquisition::Fund->delete
 698 sub DelBudget {
 699         my ($budget_id) = @_;
 700         my $dbh         = C4::Context->dbh;
 701         my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
 702         my $rc          = $sth->execute($budget_id);
 703     # Log the deletion
 704     if (C4::Context->preference("AcquisitionLog")) {
 705         logaction(
 706             'ACQUISITIONS',
 707             'DELETE_FUND',
 708             $budget_id
 709         );
 710     }
 711         return $rc;
 712 }
 713
 714
 715 # -------------------------------------------------------------------
 716
 717 =head2 GetBudget
 718
 719   &GetBudget($budget_id);
 720
 721 get a specific budget
 722
 723 =cut
 724
 725 sub GetBudget {
 726     my ( $budget_id ) = @_;
 727     my $dbh = C4::Context->dbh;
 728     my $query = "
 729         SELECT *
 730         FROM   aqbudgets
 731         WHERE  budget_id=?
 732         ";
 733     my $sth = $dbh->prepare($query);
 734     $sth->execute( $budget_id );
 735     my $result = $sth->fetchrow_hashref;
 736     return $result;
 737 }
 738
 739 # -------------------------------------------------------------------
 740
 741 =head2 GetBudgetByOrderNumber
 742
 743   &GetBudgetByOrderNumber($ordernumber);
 744
 745 get a specific budget by order number
 746
 747 =cut
 748
 749 sub GetBudgetByOrderNumber {
 750     my ( $ordernumber ) = @_;
 751     my $dbh = C4::Context->dbh;
 752     my $query = "
 753         SELECT aqbudgets.*
 754         FROM   aqbudgets, aqorders
 755         WHERE  ordernumber=?
 756         AND    aqorders.budget_id = aqbudgets.budget_id
 757         ";
 758     my $sth = $dbh->prepare($query);
 759     $sth->execute( $ordernumber );
 760     my $result = $sth->fetchrow_hashref;
 761     return $result;
 762 }
 763
 764 =head2 GetBudgetReport
 765
 766   &GetBudgetReport( [$budget_id] );
 767
 768 Get all orders for a specific budget, without cancelled orders.
 769
 770 Returns an array of hashrefs.
 771
 772 =cut
 773
 774 # --------------------------------------------------------------------
 775 sub GetBudgetReport {
 776     my ( $budget_id ) = @_;
 777     my $dbh = C4::Context->dbh;
 778     my $query = '
 779         SELECT o.*, b.budget_name
 780         FROM   aqbudgets b
 781         INNER JOIN aqorders o
 782         ON b.budget_id = o.budget_id
 783         WHERE  b.budget_id=?
 784         AND (o.orderstatus != "cancelled")
 785         ORDER BY b.budget_name';
 786
 787     my $sth = $dbh->prepare($query);
 788     $sth->execute( $budget_id );
 789
 790     my @results = ();
 791     while ( my $data = $sth->fetchrow_hashref ) {
 792         push( @results, $data );
 793     }
 794     return @results;
 795 }
 796
 797 =head2 GetBudgetsByActivity
 798
 799   &GetBudgetsByActivity( $budget_period_active );
 800
 801 Get all active or inactive budgets, depending of the value
 802 of the parameter.
 803
 804 1 = active
 805 0 = inactive
 806
 807 =cut
 808
 809 # --------------------------------------------------------------------
 810 sub GetBudgetsByActivity {
 811     my ( $budget_period_active ) = @_;
 812     my $dbh = C4::Context->dbh;
 813     my $query = "
 814         SELECT DISTINCT b.*
 815         FROM   aqbudgetperiods bp
 816         INNER JOIN aqbudgets b
 817         ON bp.budget_period_id = b.budget_period_id
 818         WHERE  bp.budget_period_active=?
 819         ";
 820     my $sth = $dbh->prepare($query);
 821     $sth->execute( $budget_period_active );
 822     my @results = ();
 823     while ( my $data = $sth->fetchrow_hashref ) {
 824         push( @results, $data );
 825     }
 826     return @results;
 827 }
 828 # --------------------------------------------------------------------
 829
 830 =head2 GetBudgetsReport
 831
 832   &GetBudgetsReport( [$activity] );
 833
 834 Get all but cancelled orders for all funds.
 835
 836 If the optionnal activity parameter is passed, returns orders for active/inactive budgets only.
 837
 838 active = 1
 839 inactive = 0
 840
 841 Returns an array of hashrefs.
 842
 843 =cut
 844
 845 sub GetBudgetsReport {
 846     my ($activity) = @_;
 847     my $dbh = C4::Context->dbh;
 848     my $query = '
 849         SELECT o.*, b.budget_name
 850         FROM   aqbudgetperiods bp
 851         INNER JOIN aqbudgets b
 852         ON bp.budget_period_id = b.budget_period_id
 853         INNER JOIN aqorders o
 854         ON b.budget_id = o.budget_id ';
 855     if ( $activity && $activity ne '' ) {
 856         $query .= 'WHERE  bp.budget_period_active=? ';
 857     }
 858     $query .= 'AND (o.orderstatus != "cancelled")
 859                ORDER BY b.budget_name';
 860
 861     my $sth = $dbh->prepare($query);
 862     if ( $activity && $activity ne '' ) {
 863         $sth->execute($activity);
 864     }
 865     else{
 866         $sth->execute;
 867     }
 868     my @results = ();
 869     while ( my $data = $sth->fetchrow_hashref ) {
 870         push( @results, $data );
 871     }
 872     return @results;
 873 }
 874
 875 =head2 GetBudgetByCode
 876
 877     my $budget = &GetBudgetByCode($budget_code);
 878
 879 Retrieve all aqbudgets fields as a hashref for the budget that has
 880 given budget_code
 881
 882 =cut
 883
 884 sub GetBudgetByCode {
 885     my ( $budget_code ) = @_;
 886
 887     my $dbh = C4::Context->dbh;
 888     my $query = qq{
 889         SELECT aqbudgets.*
 890         FROM aqbudgets
 891         JOIN aqbudgetperiods USING (budget_period_id)
 892         WHERE budget_code = ?
 893         ORDER BY budget_period_active DESC, budget_id DESC
 894         LIMIT 1
 895     };
 896     my $sth = $dbh->prepare( $query );
 897     $sth->execute( $budget_code );
 898     return $sth->fetchrow_hashref;
 899 }
 900
 901 =head2 GetBudgetHierarchySpent
 902
 903   my $spent = GetBudgetHierarchySpent( $budget_id );
 904
 905 Gets the total spent of the level and sublevels of $budget_id
 906
 907 =cut
 908
 909 sub GetBudgetHierarchySpent {
 910     my ( $budget_id ) = @_;
 911     my $dbh = C4::Context->dbh;
 912     my $children_ids = $dbh->selectcol_arrayref(q|
 913         SELECT budget_id
 914         FROM   aqbudgets
 915         WHERE  budget_parent_id = ?
 916     |, {}, $budget_id );
 917
 918     my $total_spent = GetBudgetSpent( $budget_id );
 919     for my $child_id ( @$children_ids ) {
 920         $total_spent += GetBudgetHierarchySpent( $child_id );
 921     }
 922     return $total_spent;
 923 }
 924
 925 =head2 GetBudgetHierarchyOrdered
 926
 927   my $ordered = GetBudgetHierarchyOrdered( $budget_id );
 928
 929 Gets the total ordered of the level and sublevels of $budget_id
 930
 931 =cut
 932
 933 sub GetBudgetHierarchyOrdered {
 934     my ( $budget_id ) = @_;
 935     my $dbh = C4::Context->dbh;
 936     my $children_ids = $dbh->selectcol_arrayref(q|
 937         SELECT budget_id
 938         FROM   aqbudgets
 939         WHERE  budget_parent_id = ?
 940     |, {}, $budget_id );
 941
 942     my $total_ordered = GetBudgetOrdered( $budget_id );
 943     for my $child_id ( @$children_ids ) {
 944         $total_ordered += GetBudgetHierarchyOrdered( $child_id );
 945     }
 946     return $total_ordered;
 947 }
 948
 949 =head2 GetBudgets
 950
 951   &GetBudgets($filter, $order_by);
 952
 953 gets all budgets
 954
 955 =cut
 956
 957 # -------------------------------------------------------------------
 958 sub GetBudgets {
 959     my ($filters, $orderby) = @_;
 960     $orderby = 'budget_name' unless($orderby);
 961
 962     my $rs = Koha::Database->new()->schema->resultset('Aqbudget');
 963     $rs = $rs->search( $filters, { order_by => $orderby } );
 964     $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 965     return [ $rs->all  ];
 966 }
 967
 968 =head2 GetBudgetUsers
 969
 970     my @borrowernumbers = &GetBudgetUsers($budget_id);
 971
 972 Return the list of borrowernumbers linked to a budget
 973
 974 =cut
 975
 976 sub GetBudgetUsers {
 977     my ($budget_id) = @_;
 978
 979     my $dbh = C4::Context->dbh;
 980     my $query = qq{
 981         SELECT borrowernumber
 982         FROM aqbudgetborrowers
 983         WHERE budget_id = ?
 984     };
 985     my $sth = $dbh->prepare($query);
 986     $sth->execute($budget_id);
 987
 988     my @borrowernumbers;
 989     while (my ($borrowernumber) = $sth->fetchrow_array) {
 990         push @borrowernumbers, $borrowernumber
 991     }
 992
 993     return @borrowernumbers;
 994 }
 995
 996 =head2 ModBudgetUsers
 997
 998     &ModBudgetUsers($budget_id, @borrowernumbers);
 999
1000 Modify the list of borrowernumbers linked to a budget
1001
1002 =cut
1003
1004 sub ModBudgetUsers {
1005     my ($budget_id, @budget_users_id) = @_;
1006
1007     return unless $budget_id;
1008
1009     my $dbh = C4::Context->dbh;
1010     my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
1011     my $sth = $dbh->prepare($query);
1012     $sth->execute($budget_id);
1013
1014     $query = qq{
1015         INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
1016         VALUES (?,?)
1017     };
1018     $sth = $dbh->prepare($query);
1019     foreach my $borrowernumber (@budget_users_id) {
1020         next unless $borrowernumber;
1021         $sth->execute($budget_id, $borrowernumber);
1022     }
1023 }
1024
1025 sub CanUserUseBudget {
1026     my ($borrower, $budget, $userflags) = @_;
1027
1028     if (not ref $borrower) {
1029         $borrower = Koha::Patrons->find( $borrower );
1030         return 0 unless $borrower;
1031         $borrower = $borrower->unblessed;
1032     }
1033     if (not ref $budget) {
1034         $budget = GetBudget($budget);
1035     }
1036
1037     return 0 unless ($borrower and $budget);
1038
1039     if (not defined $userflags) {
1040         $userflags = C4::Auth::getuserflags($borrower->{flags},
1041             $borrower->{userid});
1042     }
1043
1044     unless ($userflags->{superlibrarian}
1045     || (ref $userflags->{acquisition}
1046         && $userflags->{acquisition}->{budget_manage_all})
1047     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
1048     {
1049         if (not exists $userflags->{acquisition}) {
1050             return 0;
1051         }
1052
1053         if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
1054             return 0;
1055         }
1056
1057         # Budget restricted to owner
1058         if ( $budget->{budget_permission} == 1 ) {
1059             if (    $budget->{budget_owner_id}
1060                 and $budget->{budget_owner_id} != $borrower->{borrowernumber} )
1061             {
1062                 return 0;
1063             }
1064         }
1065
1066         # Budget restricted to owner, users and library
1067         elsif ( $budget->{budget_permission} == 2 ) {
1068             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
1069
1070             if (
1071                 (
1072                         $budget->{budget_owner_id}
1073                     and $budget->{budget_owner_id} !=
1074                     $borrower->{borrowernumber}
1075                     or not $budget->{budget_owner_id}
1076                 )
1077                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
1078                     @budget_users )
1079                 and defined $budget->{budget_branchcode}
1080                 and $budget->{budget_branchcode} ne
1081                 C4::Context->userenv->{branch}
1082               )
1083             {
1084                 return 0;
1085             }
1086         }
1087
1088         # Budget restricted to owner and users
1089         elsif ( $budget->{budget_permission} == 3 ) {
1090             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
1091             if (
1092                 (
1093                         $budget->{budget_owner_id}
1094                     and $budget->{budget_owner_id} !=
1095                     $borrower->{borrowernumber}
1096                     or not $budget->{budget_owner_id}
1097                 )
1098                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
1099                     @budget_users )
1100               )
1101             {
1102                 return 0;
1103             }
1104         }
1105     }
1106
1107     return 1;
1108 }
1109
1110 sub CanUserModifyBudget {
1111     my ($borrower, $budget, $userflags) = @_;
1112
1113     if (not ref $borrower) {
1114         $borrower = Koha::Patrons->find( $borrower );
1115         return 0 unless $borrower;
1116         $borrower = $borrower->unblessed;
1117     }
1118     if (not ref $budget) {
1119         $budget = GetBudget($budget);
1120     }
1121
1122     return 0 unless ($borrower and $budget);
1123
1124     if (not defined $userflags) {
1125         $userflags = C4::Auth::getuserflags($borrower->{flags},
1126             $borrower->{userid});
1127     }
1128
1129     unless ($userflags->{superlibrarian}
1130     || (ref $userflags->{acquisition}
1131         && $userflags->{acquisition}->{budget_manage_all})
1132     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
1133     {
1134         if (!CanUserUseBudget($borrower, $budget, $userflags)) {
1135             return 0;
1136         }
1137
1138         if (ref $userflags->{acquisition}
1139         && !$userflags->{acquisition}->{budget_modify}) {
1140             return 0;
1141         }
1142     }
1143
1144     return 1;
1145 }
1146
1147 sub _round {
1148     my ($value, $increment) = @_;
1149
1150     if ($increment && $increment != 0) {
1151         $value = int($value / $increment) * $increment;
1152     }
1153
1154     return $value;
1155 }
1156
1157 =head2 CloneBudgetPeriod
1158
1159   my $new_budget_period_id = CloneBudgetPeriod({
1160     budget_period_id => $budget_period_id,
1161     budget_period_startdate => $budget_period_startdate,
1162     budget_period_enddate   => $budget_period_enddate,
1163     mark_original_budget_as_inactive => 1n
1164     reset_all_budgets => 1,
1165   });
1166
1167 Clone a budget period with all budgets.
1168 If the mark_origin_budget_as_inactive is set (0 by default),
1169 the original budget will be marked as inactive.
1170
1171 If the reset_all_budgets is set (0 by default), all budget (fund)
1172 amounts will be reset.
1173
1174 =cut
1175
1176 sub CloneBudgetPeriod {
1177     my ($params)                  = @_;
1178     my $budget_period_id          = $params->{budget_period_id};
1179     my $budget_period_startdate   = $params->{budget_period_startdate};
1180     my $budget_period_enddate     = $params->{budget_period_enddate};
1181     my $budget_period_description = $params->{budget_period_description};
1182     my $amount_change_percentage  = $params->{amount_change_percentage};
1183     my $amount_change_round_increment = $params->{amount_change_round_increment};
1184     my $mark_original_budget_as_inactive =
1185       $params->{mark_original_budget_as_inactive} || 0;
1186     my $reset_all_budgets = $params->{reset_all_budgets} || 0;
1187
1188     my $budget_period = GetBudgetPeriod($budget_period_id);
1189
1190     $budget_period->{budget_period_startdate}   = $budget_period_startdate;
1191     $budget_period->{budget_period_enddate}     = $budget_period_enddate;
1192     $budget_period->{budget_period_description} = $budget_period_description;
1193     # The new budget (budget_period) should be active by default
1194     $budget_period->{budget_period_active}    = 1;
1195
1196     if ($amount_change_percentage) {
1197         my $total = $budget_period->{budget_period_total};
1198         $total += $total * $amount_change_percentage / 100;
1199         $total = _round($total, $amount_change_round_increment);
1200         $budget_period->{budget_period_total} = $total;
1201     }
1202
1203     my $original_budget_period_id = $budget_period->{budget_period_id};
1204     delete $budget_period->{budget_period_id};
1205     my $new_budget_period_id = AddBudgetPeriod( $budget_period );
1206
1207     my $budgets = GetBudgetHierarchy($budget_period_id);
1208     CloneBudgetHierarchy(
1209         {
1210             budgets              => $budgets,
1211             new_budget_period_id => $new_budget_period_id
1212         }
1213     );
1214
1215     if ($mark_original_budget_as_inactive) {
1216         ModBudgetPeriod(
1217             {
1218                 budget_period_id     => $budget_period_id,
1219                 budget_period_active => 0,
1220             }
1221         );
1222     }
1223
1224     if ( $reset_all_budgets ) {
1225         my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1226         for my $budget ( @$budgets ) {
1227             $budget->{budget_amount} = 0;
1228             ModBudget( $budget );
1229         }
1230     } elsif ($amount_change_percentage) {
1231         my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1232         for my $budget ( @$budgets ) {
1233             my $amount = $budget->{budget_amount};
1234             $amount += $amount * $amount_change_percentage / 100;
1235             $amount = _round($amount, $amount_change_round_increment);
1236             $budget->{budget_amount} = $amount;
1237             ModBudget( $budget );
1238         }
1239     }
1240
1241     return $new_budget_period_id;
1242 }
1243
1244 =head2 CloneBudgetHierarchy
1245
1246   CloneBudgetHierarchy({
1247     budgets => $budgets,
1248     new_budget_period_id => $new_budget_period_id;
1249   });
1250
1251 Clone a budget hierarchy.
1252
1253 =cut
1254
1255 sub CloneBudgetHierarchy {
1256     my ($params)             = @_;
1257     my $budgets              = $params->{budgets};
1258     my $new_budget_period_id = $params->{new_budget_period_id};
1259     next unless @$budgets or $new_budget_period_id;
1260
1261     my $children_of   = $params->{children_of};
1262     my $new_parent_id = $params->{new_parent_id};
1263
1264     my @first_level_budgets =
1265       ( not defined $children_of )
1266       ? map { ( not $_->{budget_parent_id} )             ? $_ : () } @$budgets
1267       : map { ( defined $_->{budget_parent_id} && $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;
1268
1269     # get only the columns of aqbudgets
1270     my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
1271
1272     for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
1273         @first_level_budgets )
1274     {
1275
1276         my $tidy_budget =
1277           { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
1278               keys %$budget };
1279         delete $tidy_budget->{timestamp};
1280         my $new_budget_id = AddBudget(
1281             {
1282                 %$tidy_budget,
1283                 budget_id        => undef,
1284                 budget_parent_id => $new_parent_id,
1285                 budget_period_id => $new_budget_period_id
1286             }
1287         );
1288         CloneBudgetHierarchy(
1289             {
1290                 budgets              => $budgets,
1291                 new_budget_period_id => $new_budget_period_id,
1292                 children_of          => $budget->{budget_id},
1293                 new_parent_id        => $new_budget_id
1294             }
1295         );
1296     }
1297 }
1298
1299 =head2 MoveOrders
1300
1301   my $report = MoveOrders({
1302     from_budget_period_id => $from_budget_period_id,
1303     to_budget_period_id   => $to_budget_period_id,
1304   });
1305
1306 Move orders from one budget period to another.
1307
1308 =cut
1309
1310 sub MoveOrders {
1311     my ($params)              = @_;
1312     my $from_budget_period_id = $params->{from_budget_period_id};
1313     my $to_budget_period_id   = $params->{to_budget_period_id};
1314     my $move_remaining_unspent = $params->{move_remaining_unspent};
1315     return
1316       if not $from_budget_period_id
1317           or not $to_budget_period_id
1318           or $from_budget_period_id == $to_budget_period_id;
1319
1320     # Can't move orders to an inactive budget (budgetperiod)
1321     my $budget_period = GetBudgetPeriod($to_budget_period_id);
1322     return unless $budget_period->{budget_period_active};
1323
1324     my @report;
1325     my $dbh     = C4::Context->dbh;
1326     my $sth_update_aqorders = $dbh->prepare(
1327         q|
1328             UPDATE aqorders
1329             SET budget_id = ?
1330             WHERE ordernumber = ?
1331         |
1332     );
1333     my $sth_update_budget_amount = $dbh->prepare(
1334         q|
1335             UPDATE aqbudgets
1336             SET budget_amount = ?
1337             WHERE budget_id = ?
1338         |
1339     );
1340     my $from_budgets = GetBudgetHierarchy($from_budget_period_id);
1341     for my $from_budget (@$from_budgets) {
1342         my $new_budget_id = $dbh->selectcol_arrayref(
1343             q|
1344                 SELECT budget_id
1345                 FROM aqbudgets
1346                 WHERE budget_period_id = ?
1347                     AND budget_code = ?
1348             |, {}, $to_budget_period_id, $from_budget->{budget_code}
1349         );
1350         $new_budget_id = $new_budget_id->[0];
1351         my $new_budget = GetBudget( $new_budget_id );
1352         unless ( $new_budget ) {
1353             push @report,
1354               {
1355                 moved       => 0,
1356                 budget      => $from_budget,
1357                 error       => 'budget_code_not_exists',
1358               };
1359             next;
1360         }
1361         my $orders_to_move = C4::Acquisition::SearchOrders(
1362             {
1363                 budget_id => $from_budget->{budget_id},
1364                 pending   => 1,
1365             }
1366         );
1367
1368         my @orders_moved;
1369         for my $order (@$orders_to_move) {
1370             $sth_update_aqorders->execute( $new_budget->{budget_id}, $order->{ordernumber} );
1371             push @orders_moved, $order;
1372         }
1373
1374         my $unspent_moved = 0;
1375         if ($move_remaining_unspent) {
1376             my $spent   = GetBudgetHierarchySpent( $from_budget->{budget_id} );
1377             my $unspent = $from_budget->{budget_amount} - $spent;
1378             my $new_budget_amount = $new_budget->{budget_amount};
1379             if ( $unspent > 0 ) {
1380                 $new_budget_amount += $unspent;
1381                 $unspent_moved = $unspent;
1382             }
1383             $new_budget->{budget_amount} = $new_budget_amount;
1384             $sth_update_budget_amount->execute( $new_budget_amount,
1385                 $new_budget->{budget_id} );
1386         }
1387
1388         push @report,
1389           {
1390             budget        => $new_budget,
1391             orders_moved  => \@orders_moved,
1392             moved         => 1,
1393             unspent_moved => $unspent_moved,
1394           };
1395     }
1396     return \@report;
1397 }
1398
1399 END { }    # module clean-up code here (global destructor)
1400
1401 1;
1402 __END__
1403
1404 =head1 AUTHOR
1405
1406 Koha Development Team <http://koha-community.org/>
1407
1408 =cut