C4/Budgets.pm

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