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