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