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